CODEWITHSUNDEEP
arraysvbaexcel
user3486773
user3486773

Reputation: 1246

Storing headers in string array VBA

New to VBA and am trying to essentially lookup column headers in on sheet to another and if match copy data over...

I was told that I can store my headers in a string array then loop through and compare the headers to my array to see if they match.

ie: For each c In
Sheet1.Range("A1:BA1").offset(rownumber -1)

But I'm not sure what that means? How do I store my headers in a string array? Sorry if this is a super basic question. I have googled it and not found anything explaining how to do this or what it means.

My Project: research data on sheet1. If there is an issue I want to click a button that will copy only the matching column data to a new row in a Specified sheet. From there the data will be reviewed and then another button to export the data to an MS SQL table.

ie:

Sheet1
A       B        C      D    E
ID     CUR    Region Amount Y/N
1      USD      NA    $54    Y

Sheet2
   A       B     C     D     E
Region    CUR   Amount   Type  Misc

So if Column E = Y then copy all the relevant data in that row to a new sheet:

Sheet2 (output)
   A       B     C      D     E
Region    CUR   Amount Type  Misc
  NA      USD   $54    Null  Null

Sheet2 has columns not in Sheet1 and vice versa... Also the order of the columns are not the same in each sheet. The real sheets are huge with many columns and the row count will change everytime I refresh my data. I need this to loop until Col A in Sheet1 is null.

Upvotes: 2

Views: 5015

Answers (2)

sancho.s ReinstateMonicaCellio
sancho.s ReinstateMonicaCellio

Reputation: 15561

How do I store my headers in a string array?

A very practical way:

Dim hdlist As String
Dim sep As String
hdlist = "ID|CUR|Region|Amount|Y/N"      ' Change this line
sep = "|"
Dim hdnames() As String
hdnames = Split(hdlist, sep, -1, vbBinaryCompare)

Then you can use a For loop to traverse the array.

Upvotes: 2

basodre
basodre

Reputation: 5770

Here's a piece of code that I've thrown together that I think meets your needs. I think the variable names are self explanatory, but if not, please follow up.

The code searches each cell in the header row of the origin sheet to see if it exists in the destination sheet. If so, it copies over the corresponding information.

Dim wsOrigin As Worksheet
Dim wsDest As Worksheet
Dim nCopyRow As Long
Dim nPasteRow As Long
Dim rngFnd As Range
Dim rngDestSearch As Range
Dim cel As Range

Const ORIGIN_ROW_HEADERS = 1
Const DEST_ROW_HEADERS = 1


Set wsOrigin = Sheets("Sheet1")
Set wsDest = Sheets("Sheet2")

nCopyRow = ActiveCell.Row
nPasteRow = wsDest.Cells(Rows.Count, 1).End(xlUp).Row + 1

Set rngDestSearch = Intersect(wsDest.UsedRange, wsDest.Rows(DEST_ROW_HEADERS))

For Each cel In Intersect(wsOrigin.UsedRange, wsOrigin.Rows(ORIGIN_ROW_HEADERS))
    On Error Resume Next
        Set rngFnd = rngDestSearch.Find(cel.Value)

        If rngFnd Is Nothing Then
            'Do Nothing as Header Does not Exist
        Else
            wsDest.Cells(nPasteRow, rngFnd.Column).Value = wsOrigin.Cells(nCopyRow, cel.Column).Value
        End If
    On Error GoTo 0

    Set rngFnd = Nothing
Next cel

Upvotes: 1

Related Questions