Change hard coded destination of data transfer to soft coded

[AV_Geek]

Hi Everyone: I have another one I could use help with please.

I have Data that I want to extract and copy into a Grid. In one of the columns will be what I call the ID, and the other is the location. There are several grids on my worksheet and some of the IDs may be repeated.

In the below example, “154” is my Fleet, and “HNL, MAJ, PNI, TKK, and GUM” are my locations.

The extraction of data from my source is working well and the code works great, however the destination of my data is in hard coded cells. I have over 300 Fleets and manually changing the hard coded destination cells is going to be a problem, since the cell locations change as we add or remove IDs. This is only part of a larger macro.

 'HNL

    Workbooks("154.xlsx").Activate
    Worksheets("TrainStatus").Activate

Application.ScreenUpdating = False

Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Lastrow
    If InStr(Cells(i, "A"), "HNL") Then
        Cells(i, "N").Copy
    End If
Next
Application.ScreenUpdating = True
    Workbooks("Monthly STATS.xlsm").Activate
    secondWorksheet.Activate
    ActiveSheet.Range("K6").Select
    On Error Resume Next
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

My goal is to change the destination to be soft coded to the cell where the Fleets intersects with the location. In this small example, I want the extracted data in the cell where, where 154 (in a vertical column) meets HNL (in a horizontal row).

There are 2 possible challenges:

1. There are cases where the Fleet will be duplicated. I have 2 possible solutions to that. Either A. the code places it into the first one and I link them (cellB=cellA), or they can be coded to enter in both rows. Only one of the two rows will be visible in the final presentation.
2. The Fleets aren’t always in the same column, and in some rows there are 2 Fleets.

I have included an image of a sample sheet that I will be placing my data into, and the full Macro that I’m working with. Any help would be appreciated.

Here is the full code right now for Fleet 154. Any help will be appreciated. Thanks in advance.

Sub Fleet154()

Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet
    Workbooks("154.xlsx").Activate
    RunIslandHopperWB
   A60minute_tolerence
ActiveSheet.Range("S3").Select
    Selection.Copy

'Division Delay

Dim i As Long
Dim Lastrow As Long
Dim firstWorksheet As Worksheet
Dim secondWorksheet As Worksheet

With ThisWorkbook
    Set firstWorksheet = .Sheets(Format(.Worksheets("00").Range("L2").Value, "00"))
    Set secondWorksheet = .Sheets(.Worksheets("00").Range("L4").Value)
End With

firstWorksheet.Activate
Lastrow = Cells(Rows.Count, "G").End(xlUp).Row

For i = 1 To Lastrow
    If InStr(Cells(i, "G"), "154") Then
        Cells(i, "H").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    End If
Next

Application.ScreenUpdating = True


'HNL

    Workbooks("154.xlsx").Activate
    Worksheets("TrainStatus").Activate
Application.ScreenUpdating = False
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Lastrow
    If InStr(Cells(i, "A"), "HNL") Then
        Cells(i, "N").Copy
    End If
Next
Application.ScreenUpdating = True
    Workbooks("Monthly STATS.xlsm").Activate
    secondWorksheet.Activate
    ActiveSheet.Range("K6").Select
    On Error Resume Next
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

'MAJ

    Workbooks("154.xlsx").Activate
    Worksheets("TrainStatus").Activate
Application.ScreenUpdating = False
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Lastrow
    If InStr(Cells(i, "A"), "MAJ") Then
        Cells(i, "N").Copy
    End If
Next
Application.ScreenUpdating = True
    Workbooks("Monthly STATS.xlsm").Activate
    secondWorksheet.Activate
    ActiveSheet.Range("L6").Select
    On Error Resume Next
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False


'PNI

    Workbooks("154.xlsx").Activate
    Worksheets("TrainStatus").Activate
Application.ScreenUpdating = False
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Lastrow
    If InStr(Cells(i, "A"), "PNI") Then
        Cells(i, "N").Copy
    End If
Next
Application.ScreenUpdating = True
    Workbooks("Monthly STATS.xlsm").Activate
    secondWorksheet.Activate
    ActiveSheet.Range("M6").Select
    On Error Resume Next
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False


'TKK

    Workbooks("154.xlsx").Activate
    Worksheets("TrainStatus").Activate
Application.ScreenUpdating = False
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Lastrow
    If InStr(Cells(i, "A"), "TKK") Then
        Cells(i, "N").Copy
    End If
Next
Application.ScreenUpdating = True
    Workbooks("Monthly STATS.xlsm").Activate
    secondWorksheet.Activate
    ActiveSheet.Range("N6").Select
        On Error Resume Next
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False   


'GUM

    Workbooks("154.xlsx").Activate
    Worksheets("TrainStatus").Activate
Application.ScreenUpdating = False
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To Lastrow
    If InStr(Cells(i, "A"), "GUM") Then
        Cells(i, "N").Copy
    End If
Next
Application.ScreenUpdating = True
    Workbooks("Monthly STATS.xlsm").Activate
    secondWorksheet.Activate
    ActiveSheet.Range("O6").Select
        On Error Resume Next
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

Call sourceSheet.Activate

End Sub

 

[AV_Geek]

Does anyone have any ideas as to how to do this?