lundi 16 juillet 2018

Faster Way To Calculate Data VBA

I was wondering if there is a faster way to do this in VBA. I have 100,000 + rows of info I need to do this for. I am taking the Diameter along with either the length or the height and converting it to a Length Width Height that can be used to calculate the Girth. I know about screen updating but is there anything else I can do? Maybe a case statement is better than and If statement. It takes at least 30 minutes to run or more.

Thanks In Advance.

     Sub Diamater()


'Range of all rows in column D where there is Data
    lRowA = Range("A" & Rows.Count).End(xlUp).Row
    Set ColumnA = Range("A2:A" & lRowA)
DoEvents
'Loops through every cell in Column A
    For Each cell In ColumnA
DoEvents
        Dim A As Range
        Dim B As Range
        Dim C As Range
        Dim D As Range
        Dim E As Range
        Dim F As Range
        Dim G As Range
        Dim H As Range
        Dim I As Range
        Dim J As Range
        Dim K As Range
        Dim L As Range
        Dim M As Range
        Dim N As Range
        Dim O As Range
        Dim P As Range
        Dim Q As Range
        Dim R As Range
        Dim S As Range
        Dim T As Range
        Dim U As Range
        Dim V As Range
        Dim W As Range
        Dim X As Range
        Dim Y As Range
        Dim Z As Range
        Dim AA As Range
        Dim AB As Range
        Dim AC As Range
        Dim AD As Range
        Dim AE As Range
        Dim AF As Range
        Dim AG As Range
        Dim AH As Range
        Dim AI As Range
    Set A = cell
    Set B = cell.Offset(0, 1)
    Set C = cell.Offset(0, 2)
    Set D = cell.Offset(0, 3)
    Set E = cell.Offset(0, 4)
    Set F = cell.Offset(0, 5)
    Set G = cell.Offset(0, 6)
    Set H = cell.Offset(0, 7)
    Set I = cell.Offset(0, 8)
    Set J = cell.Offset(0, 9)
    Set K = cell.Offset(0, 10)
    Set L = cell.Offset(0, 11)
    Set M = cell.Offset(0, 12)
    Set N = cell.Offset(0, 13)
    Set O = cell.Offset(0, 14)
    Set P = cell.Offset(0, 15)
    Set Q = cell.Offset(0, 16)
    Set R = cell.Offset(0, 17)
    Set S = cell.Offset(0, 18)
    Set T = cell.Offset(0, 19)
    Set U = cell.Offset(0, 20)
    Set V = cell.Offset(0, 21)
    Set W = cell.Offset(0, 22)
    Set X = cell.Offset(0, 23)
    Set Y = cell.Offset(0, 24)
    Set Z = cell.Offset(0, 25)
    Set AA = cell.Offset(0, 26)
    Set AB = cell.Offset(0, 27)
    Set AC = cell.Offset(0, 28)
    Set AD = cell.Offset(0, 29)
    Set AE = cell.Offset(0, 30)
    Set AF = cell.Offset(0, 31)
    Set AG = cell.Offset(0, 32)
    Set AH = cell.Offset(0, 33)
    Set AI = cell.Offset(0, 34)

    Dim ITEM_ID As Range
    Dim ITEM_NAME As Range
    Dim BU_CODE_DT As Range
    Dim BU_CODE_SUP As Range
    Dim Box_Count_Number As Range
    Dim PA_NO As Range
    Dim PACK_QTY_ART As Range
    Dim EVER_RECEIVED As Range
    Dim PARCEL_CODE As Range
    Dim PARCEL_RESTRICTION_TYPE As Range
    Dim Gemini_Restrict As Range
    Dim Supplier_Count As Range
    Dim Restriction_Count As Range
    Dim Supplier_Not_Restricted As Range
    Dim All_CDC_Suppliers As Range
    Dim All_CDC_Restrictions As Range
    Dim Supplier_Not_Restricted_All As Range
    Dim CLG_Calc As Range
    Dim CLG_Oversized As Range
    Dim Additional_Handling As Range
    Dim CLG_Calc_With_Tolerance As Range
    Dim CLG_Oversize_With_Tolelrance As Range
    Dim Additional_Handling_With_Tolerance As Range
    Dim ITEM_LEN As Range
    Dim ITEM_WID As Range
    Dim ITEM_HEI As Range
    Dim ITEM_WEI_GRO As Range
    Dim Dimentional_Weight As Range
    Dim Girth As Range
    Dim DWP_Length As Range
    Dim DWP_Width As Range
    Dim DWP_Height As Range
    Dim DWP_Diameter As Range
    Dim DWP_Gross_Weight As Range
    Dim DWP_Girth As Range



    Set ITEM_ID = A
    Set ITEM_NAME = B
    Set BU_CODE_DT = C
    Set BU_CODE_SUP = D
    Set Box_Count_Number = E
    Set PA_NO = F
    Set PACK_QTY_ART = G
    Set EVER_RECEIVED = H
    Set PARCEL_CODE = I
    Set PARCEL_RESTRICTION_TYPE = J
    Set Gemini_Restrict = K
    Set Supplier_Count = L
    Set Restriction_Count = M
    Set Supplier_Not_Restricted = N
    Set All_CDC_Suppliers = O
    Set All_CDC_Restrictions = P
    Set Supplier_Not_Restricted_All = Q
    Set CLG_Calc = R
    Set CLG_Oversized = S
    Set Additional_Handling = T
    Set CLG_Calc_With_Tolerance = U
    Set CLG_Oversize_With_Tolelrance = V
    Set Additional_Handling_With_Tolerance = W
    Set ITEM_LEN = X
    Set ITEM_WID = Y
    Set ITEM_HEI = Z
    Set ITEM_WEI_GRO = AA
    Set Dimentional_Weight = AB
    Set Girth = AC
    Set DWP_Length = AD
    Set DWP_Width = AE
    Set DWP_Height = AF
    Set DWP_Diameter = AG
    Set DWP_Gross_Weight = AH
    Set DWP_Girth = AI

    'Takes the Diameter and places it in the Length and Widthh Column if there is a Height and Diameter
    If DWP_Diameter > 1 And DWP_Height > 1 And DWP_Length < 1 Then
        DWP_Length.Value = DWP_Diameter.Value
        DWP_Width.Value = DWP_Diameter.Value
    End If

    'Takes the Diameter and places it in the Hieght and Widthh Column if there is a Length and Diameter
    If DWP_Diameter > 1 And DWP_Height < 1 Then

        DWP_Height.Value = DWP_Diameter.Value
        DWP_Width.Value = DWP_Diameter.Value

    End If

    'If the length is less than diameter switch the length to hieght and height to length
    If DWP_Diameter > 1 And DWP_Length < DWP_Height Then

        DWP_Height.Value = DWP_Length.Value

        DWP_Length.Value = DWP_Diameter.Value

    End If

    If DWP_Diameter > 1 And DWP_Girth = "" Then
        DWP_Girth = ((2 * DWP_Height) + (2 * DWP_Width) + DWP_Length)
    End If



Next

Aucun commentaire:

Enregistrer un commentaire