Nielsen Nitro range (Blueberry range) refresh - vba

Question

I am looking for VBA to refresh Nielsen Nitro range.
Nielsen Nitro is an application to extract data from the Database. Also range is called Blueberry range to refresh the data
I've tried to use below VBA, but it was not working
Dim acnNitro As New ACNNITRO
Dim acnNitroUpdate As ACNielsenNitro.ACNNitroUpdate
Dim WS As Worksheet
Dim bret as Boolean
acnNitro.ParentApp = Application
acnNitroUpdate = acnNitro.ACNNitroUpdate
WS = ActiveSheet 'or Set WS = WorkSheets("My Sheet")
bret = acnNitroUpdate.UpdateAllNRanges(WS, ntrSelectGet)
acnNitro = Nothing
acnNitroUpdate = Nothing
WB = Nothing
screenshot
I have also provided screenshot for the range.
Can you please suggest me for VBA code?

Answer 1

I have written a similar code for a project, find code below. It might help you!
Public Sub NeilsenRefresh()
Dim str_RngDesc As Variant
Dim bRet As Boolean
Dim RngObj As NITRORange
Dim acnNITROUpdt As Object
Dim acnNITRO As Object
Dim NRangeObj As NITRORange
Dim cRange As Object
Dim Bubble As String
Set acnNITRO = CreateObject("ACNielsenNitro.ACNNitro")
Set acnNITRO.ParentApp = ActiveWorkbook.Application
Set acnNITROUpdt = acnNITRO.ACNNitroUpdate
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
With ThisWorkbook.Sheets("Macro")
WkbName = .Range("G9").Value
Path = .Range("G12").Value
Bubble = .Range("G15").Value
Atribute = .Range("G18").Value
WkList = .Range("G6").Value
End With
'Sheets("Data").Activate
With ThisWorkbook.Sheets("Data")
lr = .Range("A1048576").End(xlUp).Row
If lr > 1 Then
.Range("Q1:Q" & lr).ClearContents
.Range("A2:A" & lr).ClearContents
.Range("B3:C" & lr).ClearContents
.Range("D2:D" & lr).ClearContents
.Range("R2:R" & lr).ClearContents
.Range("S2:S" & lr).ClearContents
End If
Set WkbList = Workbooks.Open(Path & "\" & WkList & ".xlsx")
Set wks = WkbList.Sheets("Sheet1")
lrw = wks.Range("A1048576").End(xlUp).Row
wks.Range("A2:A" & lrw).Copy
.Range("A2").PasteSpecial Paste:=xlPasteValues
wks.Range("B2:B" & lrw).Copy
.Range("D2").PasteSpecial Paste:=xlPasteValues
lr = .Range("A1048576").End(xlUp).Row
.Range("B2:C" & lr).FillDown
.Calculate
Set wksmiss = ThisWorkbook.Sheets("Missing Records")
lrw = wksmiss.Range("A1048576").End(xlUp).Row
If lrw > 1 Then wksmiss.Range("A2:B" & lrw).ClearContents
.Range("A1:D" & lr).AutoFilter Field:=2, Criteria1:="#N/A"
lrw = .Range("A1048576").End(xlUp).Row
If lrw > 1 Then
.Range("B2:B" & lrw).SpecialCells(xlCellTypeVisible).Copy
wksmiss.Range("A2").PasteSpecial Paste:=xlPasteValues
.Range("D2:D" & lrw).SpecialCells(xlCellTypeVisible).Copy
wksmiss.Range("B2").PasteSpecial Paste:=xlPasteValues
.Range("A2:D" & lrw).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
End If
.Range("A1:D" & lr).AutoFilter
.Range("B2:C" & lr).FillDown
.Calculate
.Calculate
.Range("A2:A" & lr).Copy
.Range("Q1").PasteSpecial Paste:=xlPasteValues
.Range("Q1:Q" & lr).RemoveDuplicates Columns:=1, Header:=xlNo
lrd = .Range("Q1048576").End(xlUp).Row
.Range("R1:R" & lrd).FillDown
.Range("S1:S" & lrd).FillDown
.Range("A1").Value = "Cum Name"
.Calculate
For i = 1 To lrd
CumName = .Range("Q" & i).Value
Cnt = .Range("R" & i).Value
FstIndex = .Range("S" & i).Value
RowNo = FstIndex + Cnt - 1
val1 = .Range("C" & RowNo).Value
If CumConcat = "" Then
CumConcat = val1 & ","
Else
val1 = Replace(val1, "MKT", "")
CumConcat = CumConcat & val1 & ","
End If
Next
End With
Set wkb = Workbooks.Open(Path & "\" & WkbName & ".xlsx")
Set RngObj = acnNITRO.ACNRangeUtility.GetNRange(Bubble, ActiveWorkbook)
RngObj.DimCount = 4
RngObj.DimIndex = Atribute
RngObj.DimGetString = CumConcat
str_RngDesc = RngObj.RangeDescription
Set acnNITROUpdt = acnNITRO.ACNNitroUpdate
bRet = acnNITROUpdt.UpdateNRange(ActiveWorkbook, Bubble, 0)
WkbList.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
ThisWorkbook.Sheets("Macro").Activate
MsgBox "Nielsen Refresh Completed", vbInformation
End Sub