@rwunderlich
Hi Bob,
Its nice connecting with you, May I please take your expertise in converting macro VBA code to Qlik Sense Script in Data load editor ( Backend)
Macro VBA code as follows;
Option Explicit
Private wb As Workbook
Private wb3 As Workbook
Private wsTable As Worksheet
Private wsTemp As Worksheet
Private wsVersion As Worksheet
Private wsMain As Worksheet
Private wsMultiplier As Worksheet
Private wsModifier As Worksheet
Private wsMapSelection As Worksheet
Private wsSub As Worksheet
Private wsTemplate As Worksheet
Private wsPrintMap As Worksheet
Private wsPrint As Worksheet
Private wsPositionMap As Worksheet
Private ws3 As Worksheet
Private Sub Common()
Set wb = ThisWorkbook
Set wsTemp = wb.Worksheets("temp")
Set wsTable = wb.Worksheets("Rawdata")
Set wsMultiplier = wb.Worksheets("Multiplier")
Set wsModifier = wb.Worksheets("Brand_Modifier")
Set wsVersion = wb.Worksheets("ACT")
Set wsMapSelection = wb.Worksheets("Map_Selection")
Set wsTemplate = wb.Worksheets("ByTrend")
Set wsMain = wb.Worksheets("Main")
Set wsPrintMap = wb.Worksheets("Print_Map")
Set wsPositionMap = wb.Worksheets("Position_Map")
End Sub
Sub Run()
Application.ScreenUpdating = False
Application.StatusBar = "Run"
Application.DisplayAlerts = False
Call Common
Call Update
If wsMain.Range("H9") = "YES" Then
Call ByTrend
End If
If wsMain.Range("H10") = "YES" Then
'Call DeleteCompany
Call OutPutReports
End If
'Call ByTrend
'Call ByPeriod
Application.ScreenUpdating = True
Application.StatusBar = ""
Application.DisplayAlerts = True
End Sub
Sub GenerateByTrend()
Application.ScreenUpdating = False
Application.StatusBar = "Run"
Application.DisplayAlerts = False
Call Common
Call ByTrend
Application.ScreenUpdating = True
Application.StatusBar = ""
Application.DisplayAlerts = True
End Sub
Sub GeneratePrint()
Application.ScreenUpdating = False
Application.StatusBar = "Run"
Application.DisplayAlerts = False
Call Common
Call OutPutReports
Application.ScreenUpdating = True
Application.StatusBar = ""
Application.DisplayAlerts = True
End Sub
Private Sub DeleteCompany()
Dim intCountSheet As Integer
Dim intCountRow As Integer
Dim strFilter As String
Dim rngPeriod As Range
Dim rngFinal As Range
Dim rngCheckRange As Range
Dim lngStartRow As Long
Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\" & wsMain.Range("H7"))
intCountSheet = 1
Do While intCountSheet < wb2.Sheets.Count
lngStartRow = 9
Do While lngStartRow <= 299
Set wsFilter = wb2.Worksheets(intCountSheet)
intCountRow = 1
Do While intCountRow <= wsCondition.Range("M" & wsCondition.Rows.Count).End(xlUp).Row
strFilter = wsCondition.Range("M" & intCountRow)
wsFilter.Cells.UnMerge
Set rngCheckRange = wsFilter.Rows(lngStartRow & ":" & lngStartRow + 11)
Set rngFinal = Nothing
For Each rngPeriod In Intersect(rngCheckRange, wsFilter.Columns("G"))
If rngPeriod = strFilter Then
If rngFinal Is Nothing Then Set rngFinal = rngPeriod.EntireRow
Set rngFinal = Union(rngFinal, rngPeriod.EntireRow)
wsFilter.Rows(lngStartRow + 12).Insert
End If
Next rngPeriod
intCountRow = intCountRow + 1
On Error Resume Next
rngFinal.Delete
On Error GoTo 0
'strFilter = wsCondition.Range("M" & intCountRow)
'wsFilter.Range("F7:G7").AutoFilter field:=2, Criteria1:=strFilter
Loop
lngStartRow = lngStartRow + 12
If lngStartRow = 153 Then
lngStartRow = 155
End If
Loop
intCountSheet = intCountSheet + 1
Loop
End Sub
Private Sub OutPutReports()
Dim intFirstRow As Integer
Dim strTabName As String
Dim intLastRow As Integer
Set wb3 = Workbooks.Add
wb3.Styles.Merge Workbook:=Workbooks(wb.Name)
intLastRow = wsPrintMap.Range("A" & Rows.Count).End(xlUp).Row
intFirstRow = 2
Set wsTemp = wb3.Worksheets.Add(after:=wb3.Worksheets("Sheet1"))
wsTemp.Name = "Temp"
'generate bySubs sheets
Do While intFirstRow <= intLastRow
strTabName = wsPrintMap.Range("A" & intFirstRow).Value
Set wsTemplate = wb.Worksheets("Template_BySubs")
wsTemplate.Range("F2:F2") = strTabName
wsTemplate.Calculate
wsTemplate.Cells.Copy
wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValues
Set wsPrint = wb.Worksheets("Print_BySubs")
wsPrint.Copy before:=wb3.Worksheets("Sheet1")
Set ws3 = wb3.Worksheets("Sheet1").Previous
ws3.Name = wsPrintMap.Range("B" & intFirstRow).Value
ws3.Range("G7:GT262").Value2 = wsTemp.Range("G7:GT262").Value2
ws3.Tab.ColorIndex = wsMain.Range("I16")
intFirstRow = intFirstRow + 1
wsTemp.Cells.Clear
Loop
' intLastRow = wsPrintMap.Range("C" & Rows.Count).End(xlUp).Row
' intFirstRow = 2
' Do While intFirstRow <= intLastRow
' strTabName = wsPrintMap.Range("C" & intFirstRow).Value
' Set wsTemplate = wb.Worksheets("Template_BySeg")
' wsTemplate.Range("F2:F2") = strTabName
' wsTemplate.Calculate
'
' wsTemplate.Cells.Copy
' wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValues
'
' Set wsPrint = wb.Worksheets("Print_BySeg")
' wsPrint.Copy before:=wb3.Worksheets("Sheet1")
'
' Set ws3 = wb3.Worksheets("Sheet1").Previous
' ws3.Name = wsPrintMap.Range("D" & intFirstRow).Value
'
' ws3.Range("G7:GT232").Value2 = wsTemp.Range("G7:GT232").Value2
' ws3.Tab.ColorIndex = wsMain.Range("I17")
'
' intFirstRow = intFirstRow + 1
' wsTemp.Cells.Clear
' Loop
wsTemp.Delete
'wb2.Close savechanges:=False
wb3.SaveAs Filename:=wb.Path & "\" & wsMain.Range("H8"), FileFormat:=50
wb3.Close
End Sub
Private Sub Update()
Application.ScreenUpdating = False
'common variables declaration
Dim lngStartRow As Long
Dim lngLastRow As Long
'Dim wb As Workbook
'Dim wsTable As Worksheet
'Dim wsTemp As Worksheet
'Dim wsVersion As Worksheet
'Dim wsMain As Worksheet
Dim strVersion As String
'Dim wsMultiplier As Worksheet
'Dim wsModifier As Worksheet
'Dim lngLastRow_Temp As Long
On Error GoTo errHandler:
'Set wb = ThisWorkbook
Application.Calculation = False
'clear cells in temp table
'Set wsTemp = wb.Worksheets("temp")
wsTemp.Cells.Clear
'get data from Table to temp table
lngStartRow = 1
'Set wsTable = wb.Worksheets("Rawdata")
lngLastRow = wsTable.Range("G" & Rows.Count).End(xlUp).Row
wsTable.Rows(lngStartRow & ":" & lngLastRow).Copy
wsTemp.Rows("1:1").PasteSpecial Paste:=xlPasteValues
wsTemp.Range("J2:J2") = "=INDEX(Map_Date!$E:$E,MATCH(F2,Map_Date!$A:$A,0))"
'lngLastRow_Temp = wsTemp.Range("B" & Rows.Count).End(xlUp).Row
wsTemp.Range("J2:J2").Copy
wsTemp.Range("J2:J" & wsTemp.Range("B" & Rows.Count).End(xlUp).Row).PasteSpecial Paste:=xlPasteFormulas
'convert cells to text
wsTemp.Range("M2") = "=TEXT(D2,""0"")"
wsTemp.Range("M2").Copy
wsTemp.Range("M2:M" & wsTemp.Range("B" & Rows.Count).End(xlUp).Row).PasteSpecial Paste:=xlPasteFormulas
wsTemp.Calculate
wsTemp.Range("M2:M" & wsTemp.Range("B" & Rows.Count).End(xlUp).Row).Copy
wsTemp.Range("D2:D" & wsTemp.Range("B" & Rows.Count).End(xlUp).Row).PasteSpecial Paste:=xlPasteValues
wsTemp.Columns("M:M").Clear
'apply multiplier
'Set wsMultiplier = wb.Worksheets("Multiplier")
wsTemp.Range("M2") = "=IF(SUMIFS(Multiplier!D:D,Multiplier!B:B,temp!A2,Multiplier!C:C,temp!E2)=0,1,SUMIFS(Multiplier!D:D,Multiplier!B:B,temp!A2,Multiplier!C:C,temp!E2))*H2"
wsTemp.Range("M2").Copy
wsTemp.Range("M2:M" & wsTemp.Range("B" & Rows.Count).End(xlUp).Row).PasteSpecial Paste:=xlPasteFormulas
wsTemp.Calculate
wsTemp.Range("M2:M" & wsTemp.Range("B" & Rows.Count).End(xlUp).Row).Copy
wsTemp.Range("H2:H" & wsTemp.Range("B" & Rows.Count).End(xlUp).Row).PasteSpecial Paste:=xlPasteValues
wsTemp.Columns("M:M").Clear
'apply brand modifier
'Set wsModifier = wb.Worksheets("Brand_Modifier")
wsTemp.Range("M2") = "=IFERROR(INDEX(Brand_Modifier!B:B,MATCH(D2,Brand_Modifier!A:A,0)),D2)"
wsTemp.Range("M2").Copy
wsTemp.Range("M2:M" & wsTemp.Range("B" & Rows.Count).End(xlUp).Row).PasteSpecial Paste:=xlPasteFormulas
wsTemp.Calculate
wsTemp.Range("M2:M" & wsTemp.Range("B" & Rows.Count).End(xlUp).Row).Copy
wsTemp.Range("D2:D" & wsTemp.Range("B" & Rows.Count).End(xlUp).Row).PasteSpecial Paste:=xlPasteValues
wsTemp.Columns("M:M").Clear
Application.CalculateFullRebuild
'Set wsVersion = wb.Worksheets("ACT")
wsVersion.Cells.Clear
wsTemp.Range("A1:J" & wsTemp.Range("B" & Rows.Count).End(xlUp).Row).Copy
wsVersion.Range("A1:J" & wsTemp.Range("C" & Rows.Count).End(xlUp).Row).PasteSpecial Paste:=xlPasteValues
wsTemp.Cells.Clear
Application.Calculation = True
Exit Sub
errHandler:
MsgBox "Error encountered"
Application.Calculation = True
Exit Sub
Application.ScreenUpdating = True
End Sub
Private Sub ByTrend()
'Dim wb As Workbook
'Dim wsMapSelection As Worksheet
'Dim wsTemplate As Worksheet
'Dim wsMain As Worksheet
'Dim wsSub As Worksheet
Dim strSubs As String
Dim lngCount As Long
Application.ScreenUpdating = False
Application.Calculation = False
'Set wb = ThisWorkbook
'Set wsMapSelection = wb.Worksheets("Map_Selection")
'Set wsTemplate = wb.Worksheets("ByTrend")
'Set wsMain = wb.Worksheets("Main")
wsPositionMap.Cells.Calculate
'print all subs in Map_Subs column B
lngCount = 1
'strSubs = "Subs"
strSubs = wsMapSelection.Range("B" & lngCount)
Do While strSubs <> ""
wsTemplate.Range("F2") = strSubs
Application.CalculateFullRebuild
Set wsSub = wb.Worksheets(strSubs)
wsSub.Cells.Clear
' wsTemplate.Range(wsMain.Range("B21") & wsMain.Range("B19") & ":" & wsMain.Range("B22") & wsMain.Range("B20")).Copy
' wsSub.Range(wsMain.Range("B21") & wsMain.Range("B19") & ":" & wsMain.Range("B22") & wsMain.Range("B20")).PasteSpecial Paste:=xlPasteValues
' wsSub.Range(wsMain.Range("B21") & wsMain.Range("B19") & ":" & wsMain.Range("B22") & wsMain.Range("B20")).PasteSpecial Paste:=xlPasteFormats
wsTemplate.Range("A1:FT167").Copy
wsSub.Range("A1:FT167").PasteSpecial Paste:=xlPasteValues
wsSub.Range("A1:FT167").PasteSpecial Paste:=xlPasteFormats
lngCount = lngCount + 1
strSubs = wsMapSelection.Range("B" & lngCount)
Loop
Application.Calculation = True
Application.ScreenUpdating = True
End Sub
Your help will be great appreciated!
Thank you,
