Read values from a row in one sheet and write them to a matched string in another sheets column

[iandoc]

Hi All,

I’ve been trying to write a script and whilst I’ve “sort of” learned some of the components I’d need I’m struggling to get going. I have no previous experience in VBA and whilst have some minor successes I’m a greenhorn self teaching programmer.
I haven’t been able to find an example close to what I am trying to do.



Workbook details:

The worksheet is to manage a Ballot draw for a local model railway club. Some members will only enter the ballot for 1 – 10 items while others may enter for many.

• I have two sheets
  • Sheet 1 has a header row and a blank row 2. Column A has the text “Lot 1” to “Lot 187” in cells A3:A189, column C is a formula random draw reading each row and columns E2 – AC189 will receive the data I need copied from Sheet 2
  • Sheet 2 has a header row.. Column A is “Member Name”, Columns B – FZ hold text submitted from a form (eg “Lot 1 3003 Class 24 w/tender” or “Lot 107 VTG Cylinder wagon”. Currently the smallest entry is for just one item while the largest is for 155 lots!
  • I can remove all Blanks from a row in sheet 2 using Selection.SpecialCells(xlBlanks).Delete shift:=xltoleft but as per above some rows have more cells populated than others.

NOTE! The Sheet1 Col A text is not matched exactly to the text from columns B – FZ in sheet 2. I’m assuming we can use LEFT([cellnum],6) but if the Lot is lot number 1 – 9 then the returned string potentially could be “Lot 1 3” as in “Lot 1 3003 Class 24 w/tender”. Is there a way instead search for a [space]. I could then REPLACE “Lot “ with “Lot_” thus allowing you to variably search out to the first space. That way you’d get just the Lot Number “Lot_1”, “Lot_21” or “Lot_121” from step 3a below
​

• I need the process to do the following …

• Start in Sheet 2 cell A2
• Record the NAME in a variable (MemName)
  1. If this returns a Blank Cell then you’ve reached the end of the list of submissions and can STOP
• If MemName returned is not blank then Move right into that row (CurrentRow) starting in cell B[CurrentRow] (ActionCell)
  1. Read the cell string an save the Lot number (LotString)
  2. Go to Sheet 1
  3. Search down Column A looking for a match to LotString (if you reach the a blank cell without stopping you’ve not found a match so I’m not sure how to handle that!)
  4. When a match is found move right into that row to cell E[rownum]
  5. Check for a blank cell, if not blank move right to next cell and continue to move right until you find a Blank Cell
  6. Write MemName into that Blank cell
  7. Increment ActionCell, then Return to Sheet 2 and go to cell [CurrentRow],[ActionCell]
  8. If a blank cell is found in ActionCell then you have reached the end of that users submitted lots, so drop to the next row down in Sheet2, Column A and start again from step 2.

I hope that makes sense. Sorry for the mishmash of attempted variables etc. None of my cells as yet have any ranges defined etc so if you need them or wish to change anything above for the sake of simplicity please feel free to do so.

Looking forward on a conversation that helps me understand the component parts needed for this script.

Regards

 

[Tinbendr]

Can you provide a link to a sample workbook? You can use a file sharing service like box.com or google docs.

 

[iandoc]

Sure ... https://docs.google.com/open?id=0B5MgiASi6IEUM2JZV1dwNHIyRk0

Many thanks!

 

[Tinbendr]

It really would have been better if you had a few examples of the results you expected.

See if this is close.

Public Sub ParseLotStrs()
    Dim WS1 As Worksheet
    Dim WS2 As Worksheet
    Dim lFound As Integer
    Dim WS1LR As Long
    Dim WS1LC As Long
    Dim LastRow As Long
    Dim LastCol As Long
    Dim LotStr As String
    Dim LocNum As Long
    Dim R As Long
    Dim C As Long

    Set WS1 = Worksheets("sheet1")
    With WS1
        WS1LR = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    Set WS2 = Worksheets("sheet2")

    With WS2
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row

        For R = 2 To LastRow
            LastCol = .Cells(R, .Columns.Count).End(xlToLeft).Column
            For C = 2 To LastCol
                LocNum = InStr(5, .Cells(R, C).Value, " ")
                LotStr = Trim(Mid(.Cells(R, C), 1, LocNum))
                'Debug.Print Trim(LotStr)
                lFound = Application.WorksheetFunction.Match(LotStr, WS1.Range("A1:A" & WS1LR), 0)
                If lFound <> 0 Then
                    WS1LC = WS1.Cells(lFound, WS1.Columns.Count).End(xlToLeft).Column + 1
                    If WS1LC < 5 Then WS1LC = 5
                    WS1.Cells(lFound, WS1LC).Value = .Cells(R, 1).Value
                    lFound = 0
                End If
            Next
        Next
    End With

End Sub

 

[iandoc]

Hi David, Very quick initial look shows real promise. I'll check results more thoroughly tonight. Fantastic effort thanks. Yes sorry I realised it would have helped more to populate Sheet 1 with expected results instead of just blank cells but was at work by the time I thought of that.

Cheers

 

[iandoc]

Hi again David.

This looks to be working really well! I'm would never have managed the code as you have, so now will need to do some research to understand the steps you are taking. Many many thanks.

 

[Tinbendr]

I'll be glad to explain any of it.

 

[iandoc]

HI David, are you still active in this forum?