EXCEL VBA Macro: Can this be simplified using Range?

debugcn Published at Dev

Sharif Mohamed

Sub NewPortName ()
      If ThisWorkbook.Sheets("PAR Form").Cells(2, 7).Value = "RJ45" Then
      ThisWorkbook.Sheets("PAR_import").Cells(16, 3).Value = "PCI-" +      ThisWorkbook.Sheets("Equipment details").Cells(4, 4).Value + "-" + Left(ThisWorkbook.Sheets("PAR Form").Cells(2, 13), 7)

      ElseIf ThisWorkbook.Sheets("PAR Form").Cells(2, 7).Value = "LC-LC" Then
      ThisWorkbook.Sheets("PAR_import").Cells(16, 3).Value = "PFI-" + ThisWorkbook.Sheets("Equipment details").Cells(4, 4).Value + "-" + Left(ThisWorkbook.Sheets("PAR Form").Cells(2, 13), 10) + ":" + ThisWorkbook.Sheets("PAR Form").Cells(2, 36) + " to " + Left(ThisWorkbook.Sheets("PAR Form").Cells(2, 14), 10) + ":" + ThisWorkbook.Sheets("PAR Form").Cells(2, 38)
      End If
      If ThisWorkbook.Sheets("PAR Form").Cells(3, 7).Value = "RJ45" Then
      ThisWorkbook.Sheets("PAR_import").Cells(17, 3).Value = "PCI-" + ThisWorkbook.Sheets("Equipment details").Cells(4, 4).Value + "-" + Left(ThisWorkbook.Sheets("PAR Form").Cells(3, 13), 7)

      ElseIf ThisWorkbook.Sheets("PAR Form").Cells(3, 7).Value = "LC-LC" Then
      ThisWorkbook.Sheets("PAR_import").Cells(17, 3).Value = "PFI-" + ThisWorkbook.Sheets("Equipment details").Cells(4, 4).Value + "-" + Left(ThisWorkbook.Sheets("PAR Form").Cells(3, 13), 10) + ":" + ThisWorkbook.Sheets("PAR Form").Cells(3, 36) + " to " + Left(ThisWorkbook.Sheets("PAR Form").Cells(3, 14), 10) + ":" + ThisWorkbook.Sheets("PAR Form").Cells(3, 38)
      End If

End sub

I am currently modifying this line by line for individual cells due to the nature of the output over several ranges.

I am wondering if this can be simplified using Range, Two of the ranges in question out of 7 are (M2:M100) and (N2:N100)

I will need to repeat this code and change the cells individually over 700 times to reflect 700 individual cells if I can't make this abstract

Davesexcel

Check it out,

Sub Button1_Click()
    Dim sh As Worksheet, ws As Worksheet, Esh As Worksheet
    Dim Rws As Long, Rng As Range, c As Range, cr
    Dim s1 As String, s2 As String, s3 As String

    Set sh = Sheets("PAR Form")
    Set ws = Sheets("PAR_import")
    Set Esh = Sheets("Equipment details")

    s1 = "RJ45"
    s2 = "LC-LC"
    s3 = Esh.Cells(4, 4).Value

    With sh
        Rws = .Cells(.Rows.Count, "G").End(xlUp).Row
        Set Rng = .Range(.Cells(2, "G"), .Cells(Rws, "G"))
    End With

    For Each c In Rng.Cells
        cr = c.Row
        If c = s1 Then
            ws.Cells(cr + 14, 3).Value = "PCI-" + s3 + "-" + Left(sh.Cells(cr, 13), 7)
        ElseIf c = s2 Then
            ws.Cells(cr + 14, 3).Value = "PFI-" + s3 + "-" + Left(sh.Cells(cr, 13), 10) + ":" + sh.Cells(cr, 36) + " to " + Left(sh.Cells(cr, 14), 10) + ":" + sh.Cells(cr, 38)
        End If
    Next c

End Sub

Collected from the Internet

Please contact [email protected] to delete if infringement.