excel - VBA to populate sheet

Question

Source Data Sheet

Data To be populated sheet

I have two sheets the source and the sheet where data need to be populated.

I want to fetch the numeric value from the source sheet under the corresponding column of the other sheet.

I tried this

I tried with my code adding it but its going wrong somewhere can u please check. Considering my data is already formatted with , .

Sub pop_codes() '
    Dim wsdata, wsPop As Worksheet
    Dim lngLoop1 As Long
    Dim lngLoop2 As Long
    Dim aData() As String
    Dim strData As String
    Dim DataLastRow As Integer
    Dim DataLastCol As Integer
    Set wsdata = Sheets("SourceData")
    Set wsPop = Sheets("TempData")
    DataLastRow = wsdata.Cells(wsdata.Rows.Count, "A").End(xlUp).Row
    DataLastCol = wsdata.Cells(1, wsdata.Columns.Count).End(xlToLeft).Column

    OutputRow = 2
    SearchArr = Array("AV", "CS", "P", "X", "FW", "H", "J", "L", "M", "N", "P", "PD", "PK", "R", "S", "T", "V", "W", "X", "BK", "CP", "FX", "HD", "IP", "IU")
    For OutputRow = 2 To DataLastRow
        For OutputCol = 2 To DataLastCol
           strData = wsdata.Cells(OutputRow, OutputCol)
           ' strData = Replace(strData, ")", ",")
           ' strData = Replace(strData, "(", ",")
           'strData = Replace(strData, " ", "")
            aData() = Split(strData, ",")
            For lngLoop1 = LBound(aData, 1) To UBound(aData, 1)
                For lngLoop2 = LBound(SearchArr) To UBound(SearchArr)
                    If InStr(aData(lngLoop1), SearchArr(lngLoop2)) > 0 Then
                        wsPop.Cells(OutputRow, 1) = wsdata.Cells(OutputRow, 1)
                        wsPop.Cells(OutputRow, 2) = wsdata.Cells(1, DataLastCol)
                        wsPop.Cells(OutputRow, 3) = SearchArr(lngLoop2)
                        wsPop.Cells(OutputRow, 4) = Replace(aData(lngLoop1), SearchArr(lngLoop2), "")
                        OutputRow = OutputRow + 1
                    End If
                Next lngLoop2
            Next lngLoop1
        Next OutputCol
    Next OutputRow
sExit:
    On Error Resume Next
    Set wbData = Nothing
    Set wsPop = Nothing
    Exit Sub
E_Handle:
    MsgBox Err.Description & vbCrLf & vbCrLf & "sDataSource", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

Answer 1

I'd use a "stepping" worksheet that I would populate with the split data from your first worksheet. This could then be used as the basis for your final worksheet.

Some VBA code to do this would be:

Sub sDataSource()
    On Error GoTo E_Handle
    Dim wsIn As Worksheet
    Dim lngInLastRow As Long
    Dim lngInLastCol As Long
    Dim wsOut As Worksheet
    Dim strData As String
    Dim aData() As String
    Dim aSearch() As Variant
    Dim lngLoop1 As Long
    Dim lngLoop2 As Long
    Dim lngOutRow As Long
    Dim lngInRow As Long
    Dim lngInCol As Long
    Set wsIn = Worksheets("SourceData")
    lngInLastRow = wsIn.Cells(wsIn.Rows.Count, "A").End(xlUp).Row
    lngInLastCol = wsIn.Cells(1, wsIn.Columns.Count).End(xlToLeft).Column
    Set wsOut = Worksheets("TempData")
    lngOutRow = 2
    aSearch = Array("AV", "BK", "CP", "CS", "FW", "FX", "HD", "IP", "IU", "PD", "PK", "P", "H", "J", "L", "M", "N", "R", "S", "T", "V", "W", "X")
    For lngInRow = 2 To lngInLastRow
        For lngInCol = 2 To lngInLastCol
            strData = wsIn.Cells(lngInRow, lngInCol)
            strData = Replace(strData, ")", ",")
            strData = Replace(strData, "(", ",")
            strData = Replace(strData, " ", "")
            aData() = Split(strData, ",")
            For lngLoop1 = LBound(aData, 1) To UBound(aData, 1)
                For lngLoop2 = LBound(aSearch) To UBound(aSearch)
                    If InStr(aData(lngLoop1), aSearch(lngLoop2)) > 0 Then
                        wsOut.Cells(lngOutRow, 1) = wsIn.Cells(lngInRow, 1)
                        wsOut.Cells(lngOutRow, 2) = wsIn.Cells(1, lngInCol)
                        wsOut.Cells(lngOutRow, 3) = aSearch(lngLoop2)
                        wsOut.Cells(lngOutRow, 4) = Replace(aData(lngLoop1), aSearch(lngLoop2), "")
                        aData(lngLoop1) = ""
                        lngOutRow = lngOutRow + 1
                    End If
                Next lngLoop2
            Next lngLoop1
        Next lngInCol
    Next lngInRow
sExit:
    On Error Resume Next
    Set wsIn = Nothing
    Set wsOut = Nothing
    Exit Sub
E_Handle:
    MsgBox Err.Description & vbCrLf & vbCrLf & "sDataSource", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

In this code, I've looped the worksheet and got the value for each week/user. I've replaced the brackets with commas, and removed any spaces. This has then been split into an array, and I then walk this array, checking for each of the different values (i.e. CS, P, AV, X) that I am looking for. If I find it, then output this element of the array, replacing the text part with an empty string).

Code has been modified to deal with the fact that some data names can cause duplication (i.e. "P" and "CP") when using InStr(), and I have dealt with this by putting the two character data names at the start of the array, and if there is a match, then setting the element of the data array to be a zero length string.

Regards,