Macro to speed up manual task (Cant understand the logic needed)

[lforster96]

I am developing a macro for work to speed up a task that usually takes a week or so to manually input. I have got most of the code done however i am struggling to understand how to do the next step.
I have managed to structure the outputted sheet from the macro, however when filling in the value i cannot seem to understand what is needed to be done.
Column A (Old sheet) is inputted along row 1 from column F onward (With no duplicates). Column GB and FO (Old sheet) go into column B and C (New sheet) respectively, with no duplicates. Then, depending on the number in column A (Old sheet) and the Zone and sheet number (Old sheet) the value in Column C (Old sheet) is inputted in the correct position in the newsheet.

However, there are occasions where there are multiple entries for each column and zone/sheet. The number of entries is not consistent. This is proving me difficulties as i cannot seem to get the Zone/Sheet Column B and C (New sheet) to move down the correct number of times depending on entries. See photo for better explanation.

When they are multiple entries, there should be a space between the zones to represent how many multiple entries there are. BUT this should only be the largest number of matches for the columns. (e.g. if zone l12 and column F had 4 matches, and zone l12 and column G had 5 matches, there should be five spaces between the next zone to multiple entries can be inputted. I have tried to explain this the best i can and provide clear photos.

Sub GenerateTable()

Application.ScreenUpdating = False

Dim RawDataWsNotificationRng, ModifiedDataWsNotificationRng As Variant
Dim cell As Range
Dim RawDataWsNotificationlrow, ModifiedDataWsNotificationlcolnum, ModifiedDataWsZoneLrow As Long
Dim ModifiedDataWsNotificationlcol As String
Dim serverfilename, DataSheetName, Newsheetname As String
Dim wkbk1, wkbk2 As Workbook
Dim RawDataWs, ModifiedDataWs As Worksheet
Dim FindNotificationNumber As Variant

serverfilename = InputBox("Please input name of dummy workbook (file must be open, include .xlsx")
If serverfilename = "" Then Exit Sub

Set wb1 = ThisWorkbook
Set wb2 = Workbooks(serverfilename)

DataSheetName = InputBox("Please enter name of sheet where data is stored")
If DataSheetName = "" Then Exit Sub

Set RawDataWs = wb2.Sheets(DataSheetName)
Set ModifiedDataWs = Sheets.Add(After:=Sheets(Sheets.Count))

Newsheetname = InputBox("Please enter name of new sheet")
ModifiedDataWs.Name = Newsheetname

RawDataWsNotificationlrow = RawDataWs.Range("A" & Rows.Count).End(xlUp).Row
ModifiedDataWsZoneLrow = ModifiedDataWs.Range("B" & Rows.Count).End(xlUp).Row

ModifiedDataWsNotificationlcolnum = ModifiedDataWs.Cells(1, Columns.Count).End(xlToLeft).Column + 1
ModifiedDataWsNotificationlcol = Split(Cells(1, ModifiedDataWsNotificationlcolnum).Address, "$")(1)

Set RawDataWsNotificationRng = RawDataWs.Range("A2:A" & RawDataWsNotificationlrow)
Set ModifiedDataWsNotificationRng = ModifiedDataWs.Range("F1:" & ModifiedDataWsNotificationlcol & "1")

With ModifiedDataWs
    .Cells(1, "A").Value = "Feature Code"
    .Cells(1, "B").Value = "Zone"
    .Cells(1, "C").Value = "Sheet"
    .Cells(1, "D").Value = "Feature Description"
    .Cells(1, "E").Value = "'-TEN OGV KH73126 tolerance"
    .Cells(1, "F").Value = "'-TEN OGV KH73126 tolerance"
    .Cells(2, "E").Value = "Nominal"
    .Cells(2, "F").Value = "Tolerance"
    
    For Each cell In RawDataWsNotificationRng
    
        Set ModifiedDataWsNotificationRng = .Range("G1:" & ModifiedDataWsNotificationlcol & "1")
        Set FindNotificationNumber = ModifiedDataWsNotificationRng.Find(What:=RawDataWs.Cells(cell.Row, "A"), lookat:=xlWhole)
        
        If FindNotificationNumber Is Nothing Then
            ModifiedDataWsNotificationlcolnum = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
            ModifiedDataWsNotificationlcol = Split(Cells(1, ModifiedDataWsNotificationlcolnum).Address, "$")(1)
            Cells(1, ModifiedDataWsNotificationlcol).Value = cell.Value
        End If
 
    Next cell
    
Dim RawDataWsZoneRng As Variant: Set RawDataWsZoneRng = RawDataWs.Range("GB2:GB" & RawDataWsNotificationlrow)
Dim ModifiedDataWsZoneRng As Variant: Set ModifiedDataWsZoneRng = ModifiedDataWs.Range("B:B")
Dim RawDataWsExtentRng As Variant: Set RawDataWsExtentRng = RawDataWs.Range("C2:C" & RawDataWsNotificationlrow)
Dim cel As Range
        
    For Each cell In RawDataWsZoneRng
        Set FindZoneInModifiedWs = ModifiedDataWsZoneRng.Find(What:=cell.Value, lookat:=xlWhole)
            If FindZoneInModifiedWs Is Nothing Then
                ModifiedDataWsZoneLrow = .Range("B" & Rows.Count).End(xlUp).Row
                .Cells(ModifiedDataWsZoneLrow + 1, "B").Value = cell.Value
                .Cells(ModifiedDataWsZoneLrow + 1, "C").Value = RawDataWs.Cells(cell.Row, "FO").Value
            End If
    Next cell
    
    For Each cell In RawDataWsExtentRng
        Set FindNotificationNumber = ModifiedDataWsNotificationRng.Find(What:=RawDataWs.Cells(cell.Row, "A"), lookat:=xlWhole)
        Set FindZoneInModifiedWs = ModifiedDataWsZoneRng.Find(What:=RawDataWs.Cells(cell.Row, "GB"), lookat:=xlWhole)
            If IsEmpty(.Cells(FindZoneInModifiedWs.Row, FindNotificationNumber.Column)) = True Then
                .Cells(FindZoneInModifiedWs.Row, FindNotificationNumber.Column).Value = cell.Value
            Else
                For Each cel In .Columns(FindNotificationNumber.Column).Cells
                    If IsEmpty(cel) = True Then
                        i = cel.Row
                        Exit For
                    Else
                    End If
                    
                Next cel
                    .Cells(i, FindNotificationNumber.Column).Value = cell.Value
            End If
    Next cell
    
Application.ScreenUpdating = True

End With

 End Sub

 

[jasonb75]

I have tried to explain this the best i can and provide clear photos.

The number of views and lack of replies would indicate otherwise. Your choice of colour scheme makes the headings in the first picture almost illegible. In addition to this, the data in the second sheet doesn't appear to match the first. To show a clear example, both should use the same data and be consistent with your explanation.

In addition to this, the idea of having to re-type the sample data tends to put people off helping, it would be preferable if you post your samples in a format that can be copied for testing (see link below)

XL2BB - Excel Range to BBCode

Convert selected range to BBCode to include as a snapshot in your question.

www.mrexcel.com