title: Optimizing macro for organizing data
body: <p>I've got some csv export from a Database that I want to organise, I've made a VBA macro in excel that takes around 40 min to finish and I would like to know how to optimise it (Mainly to learn).</p>
  
  <p>Imagine that you got different fruit shops that sells different fruits and the csv you get is like:</p>
  
  <p>Worksheets("Temp1")=</p>
  
  <pre><code>Shop 1 ¦ Apple ¦ 10
  Shop 1 ¦ Melon ¦ 20
  Shop 2 ¦ Apple ¦ 30
  Shop 3 ¦ Mango ¦ 40
  Shop 1 ¦ Mango ¦ 50
  </code></pre>
  
  <p>I've already created a sheet like:</p>
  
  <p>Worksheets(NameOfWorkbook) =</p>
  
  <pre><code>      ¦Shop 1¦Shop 2¦Shop 3 
  Apple
  Melon
  Mango
  </code></pre>
  
  <p>And I want a macro that populate the last sheet like:</p>
  
  <p>Worksheets(NameOfWorkbook) =</p>
  
  <pre><code>      ¦Shop 1¦Shop 2¦Shop 3 
  Apple ¦10    ¦30
  Melon ¦20    ¦
  Mango ¦50    ¦      ¦40
  </code></pre>
  
  <p>So the macro I use is a triple for loop as:</p>
  
  <pre><code>For i = 1 To 1500
      For j = 1 To 150
         For k = 1 To 300
         If Worksheets("Temp1").Cells(i, 1) = Worksheets(NameOfWorkbook).Cells(1, j) And Worksheets("Temp1").Cells(i, 2) = Worksheets(NameOfWorkbook).Cells(k, 1) Then
              Worksheets(NameOfWorkbook).Cells(k, j) = Worksheets("Temp1").Cells(i, 3)
             End If
        Next k
      Next j
  Next i
  </code></pre>
  
  <p>I would like to know away to optimize the code, any help would be much appreciated.</p>
  
  <p>Thanks very much.</p>
  
  <p>Kind Regards.</p>
  
  <hr>
  
  <h2>EDIT</h2>
  
  <p>Thanks so much for your comments and answers, much appreciated.</p>
  
  <p>I did look about pivoting tables, however, I was not sure how to apply it into my problem, as one of the columns(Shops) may need to be pivoted, but the column with values will disperse populating the sheet and will not remain as a single column.</p>
  
  <p>Please find below the full code:</p>
  
  <p>the workflow is as:</p>
  
  <p>Step 0:
  Disable applications that may slow the performance, create 2no of temporary sheets "Temp1" and "Temp2" to organise the info and create a sheet where all the information will be displayed naming it with actual date and time.</p>
  
  <p>Step 1:
  Open warehouse 1 report .csv and import the data, as not all columns need to be imported</p>
  
  <p>Step 2:
  Open warehouse 2 report .csv and import the data, as not all columns need to be imported</p>
  
  <p>Step 3:
  Open report .csv and import the data into "Temp1"</p>
  
  <p>Step 4:
  As some data is duplicated (Example: I sell 3 apples from shop 1  on day 1 and 4 apples from shop1 on day 5), i join the values of Shop1 &amp;&amp; Apples to remove duplicates and add the values for Shop1 &amp;&amp; Apples for a total of 7 and then split Shop1 and Apples in different columns</p>
  
  <p>Step 5:
  Join the stock as the date is not important but the total value</p>
  
  <p>Step 6:
  Split the shop and fruit values</p>
  
  <p>Step 7:
  The value in the report is not the want to be displayed, so I replace it from the imported column from the warehouse (Example: in report.csv "apples" are displayed as "AP" and "Mango" as "MG")</p>
  
  <p>Step 8:
  The name of shops was copied into sheet"Temp2" this code is to organise them alphabetically before copying them into column1 of the final sheet, also I change columns width and orientation for easy read</p>
  
  <p>Step 9:
  The populating code, I substituted mine from Dy.Lee, the run time went down 40 min to less than 30 sec (I'm honestly impressed and gratefully, thanks, really thanks)</p>
  
  <p>Step 10:
  Delete auxiliary sheets and re-activate applications</p>
  
  <p>However, after using DY.Lee code, the values of the populating code are displayed from row 303 and below, not matching their shop and fruit (?)</p>
  
  <pre><code>Sub Import()
  Dim FileToOpen As Variant
  Dim OpenBook As Workbook
  Dim NameOfWorkbook As String
  Dim arr As Variant
  Application.Calculation = xlCalculationManual
  Application.DisplayStatusBar = False
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Sheets.Add(After:=ActiveSheet).Name = "Temp1"
  Sheets.Add(After:=ActiveSheet).Name = "Temp2"
  Sheets.Add(After:=ActiveSheet).Name = "Stock at " &amp; Format(Now, "DD-MM-YY HH-MM")
  NameOfWorkbook = ActiveSheet.Name
  
  'Step 1 open the Warehouse 1 book to import the data into NameOfWorkbook
  
  FileToOpen = Application.GetOpenFilename(Title:="Select Warehouse 1 stock report in csv format")
      If FileToOpen &lt;&gt; False Then
      Set OpenBook = Application.Workbooks.Open(FileToOpen)
      OpenBook.Sheets(1).Columns(3).Copy Destination:=ThisWorkbook.Sheets(NameOfWorkbook).Columns(1)
      OpenBook.Sheets(1).Columns(4).Copy Destination:=ThisWorkbook.Sheets(NameOfWorkbook).Columns(2)
      OpenBook.Sheets(1).Columns(7).Copy Destination:=ThisWorkbook.Sheets(NameOfWorkbook).Columns(3)
      ThisWorkbook.Sheets(NameOfWorkbook).Range("C1").Value = "Warehouse 1 Stock Available"
      OpenBook.Close False
      End If
  
  'Step 2 open the Warehouse 2 book to import the data into NameOfWorkbook
  
  FileToOpen = Application.GetOpenFilename(Title:="Select Warehouse 2 stock report in csv format")
      If FileToOpen &lt;&gt; False Then
      Set OpenBook = Application.Workbooks.Open(FileToOpen)
      OpenBook.Sheets(1).Columns(7).Copy Destination:=ThisWorkbook.Sheets(NameOfWorkbook).Columns(4)
      ThisWorkbook.Sheets(NameOfWorkbook).Range("D1").Value = "Warehouse 2 Yard Stock Available"
      OpenBook.Close False
      End If
  
  Sheets(NameOfWorkbook).Columns("A:D").sort key1:=Range("B2"), _
        order1:=xlAscending, Header:=xlYes
  
  'Step 3 open the stock book to import the data into Temp1
  
  FileToOpen = Application.GetOpenFilename(Title:="Select Current Hires report in csv format")
      If FileToOpen &lt;&gt; False Then
      Set OpenBook = Application.Workbooks.Open(FileToOpen)
      arr = OpenBook.Sheets(1).Range("A1").CurrentRegion
      rowCount = UBound(arr, 1)
      columnCount = UBound(arr, 2)
      ThisWorkbook.Sheets("Temp1").Range("A1").Resize(rowCount, columnCount).Value = arr
      OpenBook.Close False
      End If
  
  'Step 4 join Site number with item for join stock from different days
  
  Dim arr2 As Variant
  Dim i As Long, SiteName As Variant
  
  arr2 = ThisWorkbook.Sheets("Temp1").Range("A1").CurrentRegion
      For i = LBound(arr2) To UBound(arr2)
      SiteName = split(arr2(i, 2), " - ")
      arr2(i, 1) = SiteName(UBound(SiteName)) &amp; " &amp;&amp; " &amp; ThisWorkbook.Sheets("Temp1").Cells(i, 4).Value
      arr2(i, 2) = ThisWorkbook.Sheets("Temp1").Cells(i, 7).Value
      Next i
  
  rowCount = UBound(arr2, 1)
  columnCount = UBound(arr2, 2)
  ThisWorkbook.Sheets("Temp1").Range("A1").Resize(rowCount, columnCount).Value = arr2
  ThisWorkbook.Sheets("Temp1").Columns("c:M").EntireColumn.Delete
  
  'Step 5 join stock from same site sent different days
  
  Dim WorkRng As Range
  Dim Dic As Variant
  On Error Resume Next
  Set WorkRng = Range("A2:B5000")
  Set Dic = CreateObject("Scripting.Dictionary")
  arr = WorkRng.Value
  For i = 1 To UBound(arr, 1)
      Dic(arr(i, 1)) = Dic(arr(i, 1)) + arr(i, 2)
  Next
  WorkRng.ClearContents
  WorkRng.Range("A1").Resize(Dic.Count, 1) = Application.WorksheetFunction.transpose(Dic.Keys)
  WorkRng.Range("B1").Resize(Dic.Count, 1) = Application.WorksheetFunction.transpose(Dic.items)
  
  
  
  'Step 6 Separate site and material
  arr3 = ThisWorkbook.Sheets("temp1").Range("A1").CurrentRegion
  For i = 2 To UBound(arr3, 1)
      ThisWorkbook.Sheets("Temp1").Cells(i, 3) = ThisWorkbook.Sheets("Temp1").Cells(i, 2)
      RESULT = split(ThisWorkbook.Sheets("Temp1").Cells(i, 1), " &amp;&amp; ")
      ThisWorkbook.Sheets("Temp1").Cells(i, 1) = RESULT(0)
      ThisWorkbook.Sheets("Temp1").Cells(i, 2) = RESULT(1)
      Next
  
  'Step 7 replace item code with name
  
  arr4 = ThisWorkbook.Sheets("temp1").Range("A1").CurrentRegion
  For i = 2 To UBound(arr4, 1)
      For j = 2 To 300
          If Worksheets("Temp1").Cells(i, 2) = Worksheets(NameOfWorkbook).Cells(j, 1) Then
              Worksheets("Temp1").Cells(i, 2) = Worksheets(NameOfWorkbook).Cells(j, 2)
              End If
      Next j
  Next i
  
  'ThisWorkbook.Sheets(NameOfWorkbook).Columns("A:A").EntireColumn.Delete
  
  'Step 8 copy and order stock
  
  Sheets("temp2").Range("a1:a5000").Value = Sheets("Temp1").Range("a1:a5000").Value
  Sheets("temp2").Columns(1).RemoveDuplicates Columns:=Array(1)
  ThisWorkbook.Sheets("Temp2").Columns("A:A").sort key1:=ThisWorkbook.Sheets("Temp2").Range("A2"), order1:=xlAscending, Header:=xlYes
  
  
  
  For i = 5 To 100
      Sheets(NameOfWorkbook).Cells(1, i).Value = Sheets("temp2").Cells(i, 1).Value
      Next
  
  Sheets(NameOfWorkbook).Rows(1).orientation = 90
  Worksheets(NameOfWorkbook).Columns().columnwidth = 3
  Worksheets(NameOfWorkbook).Columns("B").columnwidth = 50
  Worksheets(NameOfWorkbook).Columns("C").columnwidth = 6
  Worksheets(NameOfWorkbook).Columns("D").columnwidth = 6
  Worksheets(NameOfWorkbook).Columns("A").Hidden = True
  
  'Step 8 populate the main sheet
  
  'For i = 1 To 1500
  '    For j = 1 To 150
  '       For k = 1 To 300
  '       If Worksheets("Temp1").Cells(i, 1) = Worksheets(NameOfWorkbook).Cells(1, j) And Worksheets("Temp1").Cells(i, 2) = Worksheets(NameOfWorkbook).Cells(k, 1) Then
  '            Worksheets(NameOfWorkbook).Cells(k, j) = Worksheets("Temp1").Cells(i, 3)
  '            End If
  '       Next k
  '    Next j
  'Next i
  
  
      Dim c As Object ' Dictionary
      Dim r As Object ' Dictionary
      Dim Ws As Worksheet
      Dim toWs As Worksheet
      Dim vDB, vR()
      Dim k As Long
      Dim x As Long, y As Long
  
  
      Set Ws = Sheets("Temp1")
      Set toWs = Sheets(NameOfWorkbook)
  
      Set c = CreateObject("Scripting.Dictionary") 'shops
      Set r = CreateObject("Scripting.Dictionary") 'fruit
  
      vDB = Ws.Range("a1").CurrentRegion
  
      For i = 2 To UBound(vDB, 1) 'if have header in sheet temp1 then i start with 2
          If Not c.Exists(vDB(i, 1)) Then
              k = k + 1
              c.Add vDB(i, 1), k  'Shop
          End If
          If Not r.Exists(vDB(i, 2)) Then
              j = j + 1
              r.Add vDB(i, 2), j  'Fruit
          End If
      Next i
      ReDim vR(1 To j, 1 To k)
      For i = 2 To UBound(vDB, 1) 'if have header in sheet temp1 then i start with 2
          x = c.Item(vDB(i, 1))
          y = r.Item(vDB(i, 2))
          vR(y, x) = vR(y, x) + vDB(i, 3)
      Next i
  
      With toWs
          .Range("a1").CurrentRegion.Clear
          .Range("a2").Resize(j, 1) = WorksheetFunction.transpose(r.Keys)
          .Range("b1").Resize(1, k) = c.Keys
          .Range("b2").Resize(j, k) = vR
      End With
  
  'Step 9 delete auxiliar sheets
  
  'ThisWorkbook.Sheets("Temp1").Delete
  'ThisWorkbook.Sheets("Temp2").Delete
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Application.DisplayStatusBar = True
  Application.EnableEvents = True
  End Sub
  '
  </code></pre>
  
  <p>Please find files:</p>
  
  <p><a href="https://drive.google.com/file/d/1JBwmwIsqB5XrJpYH2nmROF8MfZeOXgkw/view?usp=sharing" rel="nofollow noreferrer">https://drive.google.com/file/d/1JBwmwIsqB5XrJpYH2nmROF8MfZeOXgkw/view?usp=sharing</a>
  <a href="https://drive.google.com/file/d/1fskK_vg6qgBLX1p3MBDvys0_m5m5fyFG/view?usp=sharing" rel="nofollow noreferrer">https://drive.google.com/file/d/1fskK_vg6qgBLX1p3MBDvys0_m5m5fyFG/view?usp=sharing</a>
  <a href="https://drive.google.com/file/d/1qtijaWltQnVBhdeX6h71lMNKWirx7AGw/view?usp=sharing" rel="nofollow noreferrer">https://drive.google.com/file/d/1qtijaWltQnVBhdeX6h71lMNKWirx7AGw/view?usp=sharing</a>
  <a href="https://drive.google.com/file/d/12GCx_aoaMCHKp51JD6wQk9AXtu5ikTA-/view?usp=sharing" rel="nofollow noreferrer">https://drive.google.com/file/d/12GCx_aoaMCHKp51JD6wQk9AXtu5ikTA-/view?usp=sharing</a></p>