0 votes
in VBA by Beginner (2 points)

Hi Team,

Below is my data and expected result in Column G.

How to read country of India and America into Array and print the result as shown . trying to learn array.

 

Thanks in advance

mallesh

2 Answers

0 votes
by Expert (801 points)

Try this:

Sub ArrayX()
    Dim rArray As Range
    Dim vArray() As Variant
    Dim sNames() As String, nName As Integer
    Dim nColor() As Integer
    Dim lastRow As Long, nRows As Long, nRow As Long, nCol As Long
    Dim nCopied As Long, nR As Long, nC As Long
    
    Const firstCol As Long = 1  ' col A
    Const lastCol As Long = 4   ' col D
    Const nCols As Long = lastCol - firstCol + 1
    Const skipCols As Long = lastCol + 1
    Const firstRow As Long = 1
    Const nNames = 2
    
    lastRow = Cells(Rows.Count, firstCol).End(xlUp).Row
    Set rArray = Range(Cells(firstRow, firstCol), Cells(lastRow, lastCol))
    nRows = lastRow - firstRow + 1
    ReDim vArray(1 To nRows, 1 To nCols)
    vArray = rArray             ' copy Range to Variant array
    
    ReDim sNames(1 To nNames)   ' names to copy
    sNames(1) = "INDIA"
    sNames(2) = "AMERICA"
    ReDim nColor(1 To nNames)   ' color each name
    nColor(1) = 6   ' docs.microsoft.com/en-us/office/vba/api/excel.colorindex
    nColor(2) = 15  ' docs.microsoft.com/en-us/office/vba/api/excel.colorindex
    
    For nCol = 1 To nCols       ' copy heading row
        nC = firstCol + skipCols + nCol
        Cells(firstRow, nC) = vArray(1, nCol)
    Next nCol
    nCopied = 1                 ' rows copied
    For nRow = 2 To nRows
        For nName = 1 To nNames
            If UCase(vArray(nRow, 1)) = sNames(nName) Then
                nR = firstRow + nCopied
                For nCol = 1 To nCols
                    nC = firstCol + skipCols + nCol
                    Cells(nR, nC) = vArray(nRow, nCol)
                    Cells(nR, nC).Interior.ColorIndex = nColor(nName)
                Next nCol
                nCopied = nCopied + 1
            End If
        Next nName
    Next nRow
End Sub

Does this answer your question?

You might also be interested in My Excel Toolbox.

by Beginner (2 points)
Hi JWooley,

Thanks for your help, Actually I don't want colors to be copied, just for understanding purpose I had highlighted,  what will be the code if I dont want colors. Code will be shorter and easy to understand for me.

 

Thanks

mg
by Expert (801 points)

There are 5 lines related to array nColor. Simply delete those 5 lines if you don't want the result highlighted.

0 votes
by Expert (801 points)

Your question might indicate you wanted to learn about VBA's Array function, so I have provided a new macro named ArrayY. (The first was named ArrayX.) The Array function's result must be assigned to a Variant array, and it is wise to use the LBound and UBound functions with such an array. This new macro also ignores highlight colors.

Sub ArrayY()
    Dim rArray As Range
    Dim vArray() As Variant
    Dim vNames() As Variant
    Dim nName As Integer
    Dim lastRow As Long, nRows As Long, nRow As Long, nCol As Long
    Dim nCopied As Long, nR As Long, nC As Long
    
    Const firstCol As Long = 1  ' col A
    Const lastCol As Long = 4   ' col D
    Const nCols As Long = lastCol - firstCol + 1
    Const skipCols As Long = lastCol + 1
    Const firstRow As Long = 1
    
    lastRow = Cells(Rows.Count, firstCol).End(xlUp).Row
    Set rArray = Range(Cells(firstRow, firstCol), Cells(lastRow, lastCol))
    nRows = lastRow - firstRow + 1
    ReDim vArray(1 To nRows, 1 To nCols)
    vArray = rArray             ' copy Range to Variant array
    
    vNames = Array("INDIA", "AMERICA")  ' names to copy
    
    For nCol = 1 To nCols       ' copy heading row
        nC = firstCol + skipCols + nCol
        Cells(firstRow, nC) = vArray(1, nCol)
    Next nCol
    nCopied = 1                 ' rows copied
    For nRow = 2 To nRows
        For nName = LBound(vNames) To UBound(vNames)
            If UCase(vArray(nRow, 1)) = vNames(nName) Then
                nR = firstRow + nCopied
                For nCol = 1 To nCols
                    nC = firstCol + skipCols + nCol
                    Cells(nR, nC) = vArray(nRow, nCol)
                Next nCol
                nCopied = nCopied + 1
            End If
        Next nName
    Next nRow
End Sub

Which macro do you prefer?

by Expert (801 points)
edited by

The ArrayX and ArrayY macros use VBA's UCase function to accommodate irregular capitalization of names in column A. You might add VBA's Trim function to account for extraneous leading or trailing space characters:

Replace the following line:
    If UCase(vArray(nRow, 1)) = vNames(nName) Then
with this line:
    If Trim(UCase(vArray(nRow, 1))) = vNames(nName) Then

 

Welcome to wellsr Q&A
Ask any questions you have about VBA and Python and our community will help answer them. wellsr Q&A is the standalone question and answer platform for wellsr.com. If you have a question about one of our specific tutorials, please include a link back to the tutorial.

Getting Started
Register
VBA Cheat Sheets (On Sale Now)

Looking for something else? Hire our team directly through ourVBA Help page, instead.

For more programming tips visit the VBA Tutorials Blog and the Python Tutorials Blog.

...