copy column data from one array to another

LlebKcir

Board Regular
Joined
Oct 8, 2018
Messages
219
2 workbooks, Master & Comm. Both have tables. The master holds more columns than the table in the Comm workbook.

I have been able to successfully identify the different order and correct columns between the two.
ex: Master table(s) have the order Column {1, 2, 3, ...} while the Comm table might have Column {15, 2, 41, ...}

So the first part of the loop identifies the column from Master table(s) [hard coded to one table for now] in the order of the table on Comm workbook.

Code:
Private Function ColNumToLet(ByVal dividend As Long)
    Dim columnName As String
    Dim modulo As Integer
    Dim tmp As Integer
    Dim char As String
    
    Do While dividend > 0
        modulo = (dividend - 1) Mod 26
        tmp = 65 + modulo
        char = Chr(tmp)
        columnName = char & columnName
        dividend = CInt((dividend - modulo) / 26)
    Loop
    ColNumToLet = columnName
End Function

The above private function converts the column # into the alphabetic value, so column 27 = AA and that works great. See images for the error and the step-through to find the location of the error.

The error is when I am attempting to populate the colSortedArr with data from masterSheetArr

Asking for help with that section.

Code:
Sub TEST()
    Dim arrm As Variant
    Dim arrc As Variant
    Dim masterSheetArr As Variant
    Dim colSortedArr As Variant
    Dim commSheetArr As Variant
    Dim wbm As Workbook
    Dim wsm As Worksheet
    Dim wbc As Workbook
    Dim wsc As Worksheet
    Dim lColm As String
    Dim lColc As String
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim lColmNum As Long
    Dim lColcNum As Long
    Dim LastRow As Integer
    
    Dim search As String
    
    Set wbm = ThisWorkbook
    Set wsm = wbm.Sheets("City")
    Set wbc = Workbooks("Comm.xlsm")
    Set wsc = wbc.Sheets("Overview2")
    LastRow = wsm.Cells(wsm.Rows.Count, "A").End(xlUp).Row
        
    lColmNum = wsm.Cells(1, Columns.Count).End(xlToLeft).Column
    lColm = ColNumToLet(lColmNum)
    lColcNum = wsc.Cells(1, Columns.Count).End(xlToLeft).Column
    lColc = ColNumToLet(lColcNum)
    masterSheetArr = wbm.Sheets("City").Range("A2:" & lColm & "1000")
    
    arrm = wsm.Range("A1:" & lColm & "1").Value2
    arrc = wsc.Range("A1:" & lColc & "1").Value2

    For i = 1 To lColcNum
        search = CStr(arrc(1, i))
        If search = "" Then GoTo done
        For j = 1 To lColmNum
            If CStr(arrm(1, j)) = search Then
                MsgBox ("Found " & search & " at " & j)
                'TODO: Copy found column data in master array (j) to sorted array (i)
                colSortedArr(i) = masterSheetArr(j)
                GoTo found
            ElseIf j = lColmNum Then
                MsgBox ("Did not find " & search)
                'TODO: Skip this column and look for next to map
            End If
        Next j
found:
    Next i
    'TODO: Search the city/network column to only copy the needed rows from sorted array to commissioning sheet array
    'TODO: Paste final array into comm sheet
done:
        
End Sub

Thank you in advance. Once I get this sorted it will be time to print the data from the colSortedArr into commSheetArr to be further manipulated by other code.
 

Attachments

  • subscript.out.of.range-29-Feb-2020.PNG
    subscript.out.of.range-29-Feb-2020.PNG
    8.2 KB · Views: 8
  • subscript.out.of.range-29-Feb-2020-code.PNG
    subscript.out.of.range-29-Feb-2020-code.PNG
    19.8 KB · Views: 9

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Try adding this just before the loop
VBA Code:
ReDim colSortedArr(1 to lColcNum)
 
Upvote 0
Try adding this just before the loop
VBA Code:
ReDim colSortedArr(1 to lColcNum)
Fluff, still same error in same place. While stepping through the code I did check and the ReDim colSortedArr(1 to lColcNum) was reading as 1 to 41, is that column 1 to column 41 with an unset amount of rows for the dimension?
 
Upvote 0
What exactly is the code trying to do?
 
Upvote 0
copy data out of the masterSheetArr by column into colSortedArr. ColSortedArr will be filtered into either a 3rd array, or just have the rows containing data that is not required deleted and ReDim Preserve on the new array before pasting data into the Comm workbook.
 
Upvote 0
Do I need to use the LastRow varible and change the (i) or (j) -> (1 to LastRow, 1 to lColcNum/lColmNum)?
 
Upvote 0
Code:
    ReDim colSortedArr(1 To LastRow, 1 To lColcNum)
    ReDim masterSheetArr(1 To LastRow, 1 To lColmNum)

That did not produce and error, but still getting the same error as the original code in the same place.
 
Upvote 0
What are you trying to put into colSortedArr array, the column headers, or the entire column of data?
 
Upvote 0
entire column data.

The table and column headers in the Comm workbook are copied from the table headers in the Master workbook. There are over 100 columns in the Master table(s), but I only need 41 of those columns worth of data copied into the Comm workbook.

To help speed things up for the copy/paste I was going to build an array in memory (colSortedArr) trim that array of the rows I do not need/want at that time, and paste the entire new array into the Comm workbook.
 
Upvote 0
Ok, try
VBA Code:
    ReDim colSortedArr(1 To UBound(masterSheetArr), 1 To lColcNum)
    For i = 1 To lColcNum
        Search = CStr(arrc(1, i))
        If Search = "" Then GoTo done
        For j = 1 To lColmNum
            If CStr(arrm(1, j)) = Search Then
                MsgBox ("Found " & Search & " at " & j)
                For k = 1 To UBound(masterSheetArr)
                   'TODO: Copy found column data in master array (j) to sorted array (i)
                   colSortedArr(k, i) = masterSheetArr(k, j)
                Next k
                Exit For
            ElseIf j = lColmNum Then
                MsgBox ("Did not find " & Search)
                'TODO: Skip this column and look for next to map
            End If
        Next j
    Next i
 
Upvote 0

Forum statistics

Threads
1,223,910
Messages
6,175,318
Members
452,634
Latest member
cpostell

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top