First time coding, want help optimizing a long macro

fcats

New Member
Joined
Jun 28, 2018
Messages
2
Hi MrExcel members,

I've been lurking the forums for a while for tips for writing my first macro, but I finally decided to make an account to ask for help optimizing my code. I feel that my code is pretty inefficient and, while the end goals are accomplished, I have to go through somewhat elaborate processes to achieve them. I think my case is a bit unique as I can't seem to find much optimization help that is relevant to my exact situation.

The issue for me is that I am working in a protected sheet as I am forced to use a template given to me from an outside source, so to circumvent a lot of the restrictions I have been using copy and paste for many uses, and I can't help but think there must be a better way.

The point of the code is basically to take information from one excel workbook and write data in another based off of it. I have code open a specific file based on the data, move data from a column in a workbook to another by use of the clipboard, read data and extract keywords, and more. I also used code that removes non-alphanumeric characters that I found online. Because there are sometimes inconsistencies between the origin templates, I tried to not rely on specific cell addresses when possible.

I'll post my code here; It's quite long and complex and probably confusing (sorry!) so if you want me to explain the purpose of specific parts then I'll be happy to explain. This is my first time doing any programming since I used Scratch in elementary school, so please try not to gag too much while you read it.

Thanks so much for the help.

PS: If you need the two types of templates I'm using then I can post them, but because they have some sensitive material I'd prefer to not have to share them because I would have to censor it.



Code:
    Public gvar_itemcount As Integer    Dim cattwocounter As Integer
    Dim CatTwoAdds As String
    Dim DynAdds As String
    Dim skuone As Range
    Public Tempwb As Workbook
    Public POwb As Workbook                          'template and PO workbooks
    
    
    Function AlphaNumericOnly(strSource As String) As String
    'for SKU to Style# converter
        Dim i As Integer
        Dim strResult As String
    
        For i = 1 To Len(strSource)
            Select Case Asc(Mid(strSource, i, 1))
                Case 48 To 57, 65 To 90, 97 To 122:
                    strResult = strResult & Mid(strSource, i, 1)
            End Select
        Next
        AlphaNumericOnly = strResult
    End Function
    Sub autotemplate()
    
    'opens
    
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
'macro code


    Dim tPath, tFile As String
    Dim WR, WRP, WA, WAP, MR, MRP, MA, MAP, designer As String
    Dim totalrng, relevantregion, retail, color, jeff As Range
    Dim clmnum, des As Integer
    Dim clip As DataObject
    
    cattwocounter = 1
    
    tPath = "C:\Users\kheijkoop\Desktop\PO TEMPLATES"  'Set to templates' filepath (keep templates in same location)
    
    WR = "X W RTW AW18.xlsx"        '   Template filename for: W RTW Main Collection
    WRP = "X W RTW Pre AW18.xlsx"   '                          W RTW Pre Collection
    WA = "X W Acc AW18.xlsx"        '                          W Other Main Collection
    WAP = "X W Acc Pre AW18.xlsx"   '                          W Other Pre Collection
    MR = "X M RTW AW18.xlsx"        '                          M RTW Main Colletion
    MRP = "X M RTW Pre AW18.xlsx"   '                          M RTW Pre Collection
    MA = "X M Acc AW18.xlsx"        '                          M Other Main Collection
    MAP = "X M Acc Pre AW18.xlsx"   '                          M Other Pre Collection
    
    Set POwb = ActiveWorkbook
    
    If POwb.Name Like "* W *" Then
        If POwb.Name Like "* RTW *" Then
            If POwb.Name Like "* PRE*" Then
                tFile = WRP
            Else
                tFile = WR
            End If
        Else
            If POwb.Name Like "* PRE*" Then
                tFile = WAP
            Else
                tFile = WA
            End If
        End If
    ElseIf POwb.Name Like "* M *" Then
        If POwb.Name Like "* RTW *" Then
            If POwb.Name Like "* PRE*" Then
                tFile = MRP
            Else
                tFile = MR
            End If
        Else
            If POwb.Name Like "* PRE*" Then
                tFile = MAP
            Else
                tFile = MA
            End If
        End If
    End If
    
    Set clip = New DataObject
10      Set Tempwb = Workbooks.Open(tPath & "\" & tFile)
    POwb.Activate
    Set totalrng = Columns(1).Find("TOTAL")
    If WorksheetFunction.CountA(totalrng) = 0 Then
        GoTo formaterror
    End If
    Set skuone = Range("A" & (CInt(Right(Left(Columns(1).Find("STYLE").address(ReferenceStyle:=xlR1C1), 2), 1)) + 1))
    If IsNumeric(Mid(totalrng.address(ReferenceStyle:=xlR1C1), 2, 2)) = True Then
        Set relevantregion = Range("A" & (CInt(Right(Left(Columns(1).Find("STYLE").address(ReferenceStyle:=xlR1C1), 2), 1)) + 1) & ":A" & CStr((CInt(Mid(totalrng.address(ReferenceStyle:=xlR1C1), 2, 2)) - 1)))
    ElseIf IsNumeric(Mid(totalrng.address(ReferenceStyle:=xlR1C1), 2, 2)) = False Then
        Set relevantregion = Range("A" & (CInt(Right(Left(Columns(1).Find("STYLE").address(ReferenceStyle:=xlR1C1), 2), 1)) + 1) & ":A" & CStr((CInt(Mid(totalrng.address(ReferenceStyle:=xlR1C1), 2, 1)) - 1)))
    End If
    relevantregion.Copy
    Tempwb.Activate
    Range("H12").Select
    Application.Run "PERSONAL.XLSB!blankremover"
    
    POwb.Activate
    relevantregion.Offset(0, 1).Copy
    Tempwb.Activate
    Range("AJ12").Select
    Application.Run "PERSONAL.XLSB!blankremover"
    
    POwb.Activate
    Set color = Rows(CInt(Right(Left(Columns(1).Find("STYLE").address(ReferenceStyle:=xlR1C1), 2), 1))).Find("COLOR", LookIn:=xlValues, SearchOrder:=xlByRows)
    relevantregion.Offset(0, CInt(Right(color.address(ReferenceStyle:=xlR1C1), 1)) - 1).Copy
    Tempwb.Activate
    Range("D12").Select
    cattwocounter = 0
    Application.Run "PERSONAL.XLSB!blankremover"
    
    cattwocounter = 2
    POwb.Activate
    Set retail = Rows(CInt(Right(Left(Columns(1).Find("STYLE").address(ReferenceStyle:=xlR1C1), 2), 1))).Find("RETAIL", LookIn:=xlValues, SearchOrder:=xlByRows)
    If WorksheetFunction.CountA(retail) = 0 Then
        GoTo formaterror
    End If
    'MsgBox (retail.address(ReferenceStyle:=xlR1C1))
    'MsgBox (CStr(Right(retail.address(ReferenceStyle:=xlR1C1), 2) - 1))
    If IsNumeric(Right(retail.address(ReferenceStyle:=xlR1C1), 2)) = True Then
        relevantregion.Offset(0, (CInt(Right(retail.address(ReferenceStyle:=xlR1C1), 2)) - 1)).Copy
    ElseIf IsNumeric(Right(retail.address(ReferenceStyle:=xlR1C1), 2)) = False Then
        relevantregion.Offset(0, (CInt(Right(retail.address(ReferenceStyle:=xlR1C1), 1)) - 1)).Copy
    End If
    Tempwb.Activate
    Range("K12").Select
    Application.Run "PERSONAL.XLSB!blankremover"
    POwb.Activate
    Dim NYATPA As Integer
    
    
    If IsEmpty(Range("B1")) And InStr(Range("C1").Value, "JEFFREY") Then
        Set jeff = Range("C1")
    ElseIf IsEmpty(Range("C1")) And InStr(Range("D1").Value, "JEFFREY") Then
        Set jeff = Range("D1")
    ElseIf IsEmpty(Range("D1")) And InStr(Range("E1").Value, "JEFFREY") Then
        Set jeff = Range("E1")
    ElseIf IsEmpty(Range("E1")) And InStr(Range("F1").Value, "JEFFREY") Then
        Set jeff = Range("F1")
    ElseIf IsEmpty(Range("F1")) And InStr(Range("G1").Value, "JEFFREY") Then
        Set jeff = Range("G1")
    Else:
        Set jeff = Range("B1")
    End If
    
    If InStr(jeff.Value, "NEW YORK") Then NYATPA = 19
    If InStr(jeff.Value, "ATLANTA") Then NYATPA = 18
    If InStr(jeff.Value, "PALO ALTO") Then NYATPA = 20


    NYATPA = NYATPA + (InStr(jeff.Value, "J") - 1)
    
    If Left(tFile, 3) = "X W" Then
        designer = Left(Right(jeff.Value, (Len(jeff) - NYATPA)), InStr(Right(jeff.Value, Len(jeff) - NYATPA), " WOMEN'S") - 1)
    End If
    If Left(tFile, 3) = "X M" Then
        designer = Left(Right(jeff.Value, (Len(jeff) - NYATPA)), InStr(Right(jeff.Value, Len(jeff) - NYATPA), " MEN'S") - 1)
    End If
    Tempwb.Activate
    clip.SetText designer
    clip.PutInClipboard
    Range("B12").PasteSpecial
    If IsEmpty(Range("C13")) = False Then
        Selection.AutoFill Destination:=Range("B12:B" & gvar_itemcount), Type:=xlFillCopy
    End If
    DoEvents
    Dim endoffilename As String
    endoffilename = Right(Tempwb.Name, (Len(Tempwb.Name) - 1))
    If InStr(Range("F12").Value, "Shoe") And InStr(Range("F" & gvar_itemcount).Value, "Shoe") Then
        endoffilename = Right(Replace(tFile, "Acc", "Shoes"), (Len(Replace(tFile, "Acc", "Shoes")) - 1))
    End If
    If InStr(Range("F12").Value, "Bag") And InStr(Range("F" & gvar_itemcount).Value, "Bag") Then
        endoffilename = Right(Replace(tFile, "Acc", "Handbags"), (Len(Replace(tFile, "Acc", "Handbags")) - 1))
    End If
    'POwb.Activate
    'cattwocounter = 3
    'Application.Run "PERSONAL.XLSB!blankremover"
    
    Application.EnableEvents = True
    Application.DisplayStatusBar = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    Tempwb.SaveAs ("C:\Users\kheijkoop\Desktop\autotemplate dump\" & designer & endoffilename)
    Exit Sub
    
formaterror:
    MsgBox ("PO is incorrectly formatted for the autotemplate. Error on Line: " & Erl)
    Exit Sub
    
    
    End Sub
    Sub blankremover()
    
    'pastes clipboard then removes all blanks in range; NOTE: only for single-column selections
    'unlike other blank removers, this uses copy pasting to bypass restrictions created by protected sheets
    
    Dim rng As Range 'initial selection
    Dim i As Integer 'loop count
    Dim a, f As Integer 'current row
    Dim b As Integer 'a+1
    Dim adrs As String 'current address based on a
    Dim cop As DataObject 'for clearing clipboard
    Dim endrng As String 'address of current last item
    Dim bdrs As String 'address of cell beneath adrs
    Dim c As Integer 'obsolete(?) blank counter
    Dim bn As Integer 'counter, -1 x # of blanks
    Dim crng As Integer 'row beneath endrng
    Dim cdrs As String 'address of crng
    Dim brng As String 'CStr of current last row
    Dim d As Integer 'blank counter for ddrs
    Dim column As String 'column of selection
    Dim catTwo As DataObject
    Dim catstr As Long
    Dim catads As Long
    Dim catbds As Long
    Dim numofblanks As Integer
    Dim blnknt As Integer
    Dim cnt As Integer
    Dim skust As String
    Dim longer As Integer
    Dim longeradd As String
    Dim lower As Integer
    Dim sizenum As Integer
    
    Set cop = New DataObject
    Set catTwo = New DataObject
    
    If cattwocounter = 3 Then
        sizenum = Len(CatTwoAdds) / 2
        Do Until s
    End If
    
    
    Selection.PasteSpecial xlPasteValues
    
    Set Tempwb = ActiveWorkbook
    
    Set rng = Selection
    
    'MsgBox (Asc(Mid(rng.address, 3, 1)))
    
    If Asc(Mid(rng.address, 3, 1)) = 36 Then
        column = (Mid(rng.address, 2, 1))
        longer = 0
    Else
        column = (Mid(rng.address, 2, 2))
        longer = 1
    End If
    
    d = 0
    i = 1
    a = CInt(Mid(rng.address, 4, [2])) - 1 + i
    f = Mid(rng.address, 4, [2])
    b = a + 1
    adrs = column & CStr(a)
    bdrs = column & CStr(b)
    bn = 0
    
    If cattwocounter = 1 Then
        catads = 0
        catbds = 0
        CatTwoAdds = CStr(12)
    End If
    If cattwocounter = 2 Then
        Dim POct, Tct As Range
        Dim MyAr(1 To 46) As String
        Dim Tctstr, CT As String
        Dim ai As Long
        Dim arcnt As Integer
        Dim stylerow As Integer
        
        
        MyAr(1) = "COAT"
        MyAr(2) = "JEANS"
        MyAr(3) = "SWEATER"
        MyAr(4) = "T-SHIRT"
        MyAr(5) = "POLO"
        MyAr(6) = "CARDIGAN"
        MyAr(7) = "HOODIE"
        MyAr(8) = "SWEATSHIRT"
        MyAr(9) = "HOODED"
        MyAr(10) = "SUIT"
        MyAr(11) = "BUTTON-UP"
        MyAr(12) = "JACKET"
        MyAr(13) = "BLAZER"
        MyAr(14) = "PANT"
        MyAr(15) = "TROUSER"
        MyAr(16) = "JOGGER"
        MyAr(17) = "CHINO"
        MyAr(18) = "DRESS"
        MyAr(19) = "BLOUSE"
        MyAr(20) = "TURTLENECK"
        MyAr(21) = "SKIRT"
        MyAr(22) = "CREWNECK"
        MyAr(23) = "RAGLAN"
        MyAr(24) = " SHIRT"
        MyAr(25) = "LEGGINGS"
        MyAr(26) = " TOP"
        MyAr(27) = " BAG"
        MyAr(28) = "TOTE"
        MyAr(29) = "CLUTCH"
        MyAr(30) = "SHOULDER "
        MyAr(31) = "HANDLE "
        MyAr(32) = "BUCKET "
        MyAr(33) = "WALLET"
        MyAr(34) = "PURSE"
        MyAr(35) = "TRAINER"
        MyAr(36) = "BOOT"
        MyAr(37) = "SNEAKER"
        MyAr(38) = "SANDAL"
        MyAr(39) = "PUMP"
        MyAr(40) = "MULE"
        MyAr(41) = "DERBY"
        MyAr(42) = "BROGUE"
        MyAr(43) = "LOAFER"
        MyAr(44) = "BELT"
        MyAr(45) = " HAT"
        MyAr(46) = "SCARF"
        
        
        
        DynAdds = CatTwoAdds
        'MsgBox (InStr(Tempwb.Name, " RTW "))
        'If InStr(Tempwb.Name, " RTW ") > 0 Then
        POwb.Activate
        stylerow = CInt(Right(Left(Columns(1).Find("STYLE").address(ReferenceStyle:=xlR1C1), 2), 1))
        stylerow = 12 - stylerow
        arcnt = 0
            For ai = LBound(MyAr) To UBound(MyAr)
                arcnt = arcnt + 1
                Set POct = Columns(2).Find(What:=MyAr(ai), LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
                
                If Not POct Is Nothing Then
                    Set Tct = POct
                    Tempwb.Activate
                    Tctstr = Range("G" & CStr(CInt(Right(POct.address, 2)) + stylerow - 1)).Value
                    CT = MyAr(arcnt)
                    catTwo.SetText Text:=Empty
                    catTwo.PutInClipboard
                    catTwo.SetText (Tctstr & " " & CT)
                    catTwo.PutInClipboard
                    Range("G" & CStr(CInt(Right(POct.address, 2)) + stylerow - 1)).PasteSpecial
                    catTwo.SetText Text:=Empty
                    catTwo.PutInClipboard
                    
                    Do
                        POwb.Activate
                        Set POct = Columns(2).FindNext(POct)
    
                        If Not POct Is Nothing Then
                            If POct.address = Tct.address Then Exit Do
                            Tempwb.Activate
                            CT = MyAr(arcnt)
                            Tctstr = Range("G" & CStr(CInt(Right(POct.address, 2)) + stylerow - 1)).Value
                            catTwo.SetText Text:=Empty
                            catTwo.PutInClipboard
                            catTwo.SetText (Tctstr & " " & CT)
                            catTwo.PutInClipboard
                            Range("G" & CStr(CInt(Right(POct.address, 2)) + stylerow - 1)).PasteSpecial
                            catTwo.SetText Text:=Empty
                            catTwo.PutInClipboard
                        Else
                            Exit Do
                        End If
                    Loop
                End If
            Next
            Tempwb.Activate
            cnt = 12
            numofblanks = (Len(CatTwoAdds) / 2) - 1
            blanknt = numofblanks
            For cnt = 12 To gvar_itemcount + blanknt
                If InStr(Range("G" & cnt).Value, "COAT") Then
                    If InStr(Tempwb.Name, " M ") Then
                        catTwo.SetText ("Clothing (MEN) Coats")
                    ElseIf InStr(Tempwb.Name, " W ") Then
                        catTwo.SetText ("Clothing (WOMEN) Coats")
                    End If
                    catTwo.PutInClipboard
                    Range("G" & cnt).PasteSpecial
                    catTwo.SetText Text:=Empty
                    catTwo.PutInClipboard
                ElseIf InStr(Range("G" & cnt).Value, "JACKET") Then
                    If InStr(Tempwb.Name, " M ") Then
                        catTwo.SetText ("Clothing (MEN) Jackets")
                    ElseIf InStr(Tempwb.Name, " W ") Then
                        catTwo.SetText ("Clothing (WOMEN) Jackets")
                    End If
                    catTwo.PutInClipboard
                    Range("G" & cnt).PasteSpecial
                    catTwo.SetText Text:=Empty
                    catTwo.PutInClipboard
                ElseIf InStr(Range("G" & cnt).Value, " BUTTON-UP  SHIRT") Then
                    If InStr(Tempwb.Name, " M ") Then
                        catTwo.SetText ("Clothing (MEN) Shirts")
                    ElseIf InStr(Tempwb.Name, " W ") Then
                        catTwo.SetText ("Clothing (WOMEN) Tops")
                    End If
                    catTwo.PutInClipboard
                    Range("G" & cnt).PasteSpecial
                    catTwo.SetText Text:=Empty
                    catTwo.PutInClipboard
                ElseIf InStr(Range("G" & cnt).Value, "POLO") And Not InStr(Range("G" & cnt).Value, "DRESS") Then
                    If InStr(Tempwb.Name, " M ") Then
                        catTwo.SetText ("Clothing (MEN) Polo Shirts")
                    ElseIf InStr(Tempwb.Name, " W ") Then
                        GoTo 101
                    End If
                    catTwo.PutInClipboard
                    Range("G" & cnt).PasteSpecial
                    catTwo.SetText Text:=Empty
                    catTwo.PutInClipboard
                ElseIf InStr(Range("G" & cnt).Value, "PANT") Or InStr(Range("G" & cnt).Value, "LEGGING") Or InStr(Range("G" & cnt).Value, "TROUSER") Then
                    If InStr(Tempwb.Name, " M ") Then
                        catTwo.SetText ("Clothing (MEN) Trousers")
                    ElseIf InStr(Tempwb.Name, " W ") Then
                        catTwo.SetText ("Clothing (WOMEN) Trousers")
                    End If
                    catTwo.PutInClipboard
                    Range("G" & cnt).PasteSpecial
                    catTwo.SetText Text:=Empty
                    catTwo.PutInClipboard
                ElseIf InStr(Range("G" & cnt).Value, "SWEATSHIRT") Then
                    If InStr(Tempwb.Name, " M ") Then
                        catTwo.SetText ("Clothing (MEN) Sweaters & Knitwear")
                    ElseIf InStr(Tempwb.Name, " W ") Then
                        catTwo.SetText ("Clothing (WOMEN) Knitwear")
                    End If
                    catTwo.PutInClipboard
                    Range("G" & cnt).PasteSpecial
                    catTwo.SetText Text:=Empty
                    catTwo.PutInClipboard
                ElseIf InStr(Range("G" & cnt).Value, "HOODIE") Then
                    If InStr(Tempwb.Name, " M ") Then
                        catTwo.SetText ("Clothing (MEN) Sweaters & Knitwear")
                    ElseIf InStr(Tempwb.Name, " W ") Then
                        catTwo.SetText ("Clothing (WOMEN) Knitwear")
                    End If
                    catTwo.PutInClipboard
                    Range("G" & cnt).PasteSpecial
                    catTwo.SetText Text:=Empty
                    catTwo.PutInClipboard
                ElseIf InStr(Range("G" & cnt).Value, "CARDIGAN") Then
                    If InStr(Tempwb.Name, " M ") Then
                        catTwo.SetText ("Clothing (MEN) Sweaters & Knitwear")
                    ElseIf InStr(Tempwb.Name, " W ") Then
                        catTwo.SetText ("Clothing (WOMEN) Knitwear")
                    End If
                    catTwo.PutInClipboard
                    Range("G" & cnt).PasteSpecial
                    catTwo.SetText Text:=Empty
                    catTwo.PutInClipboard
                ElseIf InStr(Range("G" & cnt).Value, "T-SHIRT") Then
                    If InStr(Tempwb.Name, " M ") Then
                        catTwo.SetText ("Clothing (MEN) T-Shirts & Vests")
                    ElseIf InStr(Tempwb.Name, " W ") Then
                        catTwo.SetText ("Clothing (WOMEN) Tops")
                    End If
                    catTwo.PutInClipboard
                    Range("G" & cnt).PasteSpecial
                    catTwo.SetText Text:=Empty
                    catTwo.PutInClipboard
                ElseIf InStr(Range("G" & cnt).Value, "SWEATER") Then
                    If InStr(Tempwb.Name, " M ") Then
                        catTwo.SetText ("Clothing (MEN) Sweaters & Knitwear")
                    ElseIf InStr(Tempwb.Name, " W ") Then
                        catTwo.SetText ("Clothing (WOMEN) Knitwear")
                    End If
                    catTwo.PutInClipboard
                    Range("G" & cnt).PasteSpecial
                    catTwo.SetText Text:=Empty
                    catTwo.PutInClipboard
                ElseIf InStr(Range("G" & cnt).Value, "DRESS") Then
                    If InStr(Tempwb.Name, " M ") Then
                        GoTo 101
                    ElseIf InStr(Tempwb.Name, " W ") Then
                        catTwo.SetText ("Clothing (WOMEN) Dresses")
                    End If
                    catTwo.PutInClipboard
                    Range("G" & cnt).PasteSpecial
                    catTwo.SetText Text:=Empty
                    catTwo.PutInClipboard
                ElseIf InStr(Range("G" & cnt).Value, "TOP") Then
                    If InStr(Tempwb.Name, " M ") Then
                        GoTo 101
                    ElseIf InStr(Tempwb.Name, " W ") Then
                        catTwo.SetText ("Clothing (WOMEN) Tops")
                    End If
                    catTwo.PutInClipboard
                    Range("G" & cnt).PasteSpecial
                    catTwo.SetText Text:=Empty
                    catTwo.PutInClipboard
                ElseIf InStr(Range("G" & cnt).Value, "SKIRT") Then
                    If InStr(Tempwb.Name, " M ") Then
                        GoTo 101
                    ElseIf InStr(Tempwb.Name, " W ") Then
                        catTwo.SetText ("Clothing (WOMEN) Skirts")
                    End If
                    catTwo.PutInClipboard
                    Range("G" & cnt).PasteSpecial
                    catTwo.SetText Text:=Empty
                    catTwo.PutInClipboard
                End If
            Next
101         numofblanks = (Len(CatTwoAdds) / 2) - 1
            blanknt = numofblanks
            Do Until blanknt = 0
                Range("G" & CStr(CLng(Left(Right(CStr((CLng(CatTwoAdds) - 12) / 100), (blanknt * 2)), 2)) + 1) & ":G" & (gvar_itemcount + blanknt)).Copy
                Range("G" & Left(Right(CStr((CLng(CatTwoAdds) - 12) / 100), (blanknt * 2)), 2)).PasteSpecial
                Range("B5000").Copy
                Range("G" & CStr(gvar_itemcount + blanknt)).PasteSpecial
                blanknt = blanknt - 1
            Loop
            cnt = 12
            For cnt = 12 To gvar_itemcount + 1
                If Not InStr(Range("G" & cnt).Value, "BAG") = 0 Then
                    If Not InStr(Tempwb.Name, " W ") = 0 Then
                        catTwo.SetText "Bags (WOMEN)"
                        catTwo.PutInClipboard
                        Range("F" & cnt).PasteSpecial
                        catTwo.SetText Text:=Empty
                        catTwo.PutInClipboard
                        catTwo.SetText "Bags (WOMEN) ONE_SIZE"
                        catTwo.PutInClipboard
                        Range("N" & cnt).PasteSpecial
                    ElseIf Not InStr(Tempwb.Name, " M ") = 0 Then
                        catTwo.SetText "Bags (MEN)"
                        catTwo.PutInClipboard
                        Range("F" & cnt).PasteSpecial
                        catTwo.SetText Text:=Empty
                        catTwo.PutInClipboard
                        catTwo.SetText "Bags (MEN) ONE_SIZE"
                        catTwo.PutInClipboard
                        Range("N" & cnt).PasteSpecial
                    End If
                End If
            Next
            cnt = 12
            For cnt = 12 To gvar_itemcount + 1
                If Not InStr(Range("G" & cnt).Value, "BOOT") = 0 Or Not InStr(Range("G" & cnt).Value, "SANDAL") = 0 Or Not InStr(Range("G" & cnt).Value, "SNEAKER") = 0 Or Not InStr(Range("G" & cnt).Value, "MULE") = 0 Or Not InStr(Range("G" & cnt).Value, "LOAFER") = 0 Or Not InStr(Range("G" & cnt).Value, "PUMP") = 0 Then
                    If Not InStr(Tempwb.Name, " W ") = 0 Then
                        catTwo.SetText "Shoes (WOMEN)"
                        catTwo.PutInClipboard
                        Range("F" & cnt).PasteSpecial
                    ElseIf Not InStr(Tempwb.Name, " M ") = 0 Then
                        catTwo.SetText "Shoes (MEN)"
                        catTwo.PutInClipboard
                        Range("F" & cnt).PasteSpecial
                    End If
                End If
            Next
        'End If
    End If
    Tempwb.Activate
    
100
    
    Do
        cop.SetText Text:=Empty
        cop.PutInClipboard
        a = CInt(Mid(rng.address, 4, 2)) - 1 + i - d
        If longer = 1 Then
            a = CInt(Mid(rng.address, 5, 2)) - 1 + i - d
            longeradd = Mid(rng.address, 5, 2)
        Else
            a = CInt(Mid(rng.address, 4, 2)) - 1 + i - d
            longeradd = Mid(rng.address, 4, 2)
        End If
        b = a + 1
        adrs = column & CStr(a)
        bdrs = column & CStr(b)
        brng = CStr((CInt((Right(rng.address, 2))) + bn))
        endrng = ":" & column & brng
        Select Case IsEmpty(Range(adrs))
            Case True
                c = c + 1
                    If IsEmpty(Range(bdrs)) = True Then
                        Range(column & longeradd, column & CStr(CInt(Right(rng.address, 2)) - d)).Select
                        cattwocounter = 1
                        Exit Do
                    End If
                    If cattwocounter = 0 Then
                        catbds = catbds + 1
                        catstr = CLng(Right((Range(adrs).address), 2))
                        catads = (catads + catstr) * 100
                        CatTwoAdds = CStr(catads + 12)
                        'MsgBox (CatTwoAdds)
                    End If
                    Range(bdrs & endrng).Copy
                    Range(adrs).PasteSpecial
                    cop.SetText Text:=Empty
                    cop.PutInClipboard
                    bn = bn - 1
                    brng = CStr((CInt((Right(rng.address, 2))) + bn))
                    crng = CInt(brng) + 1
                    cdrs = column & CStr(crng)
                    Range("B5000").Copy                  'generic blank cell
                    Range(cdrs).PasteSpecial
                    d = d + 1
            Case False
                c = 0
        End Select
        i = i + 1
    Loop
    
    gvar_itemcount = CInt(Right(rng.address, 2)) - d
    
    If column = "H" Then                                  'starts DeSKU if inputed are SKUs
        cnt = 12
        For cnt = 12 To gvar_itemcount
            skust = Range("H" & cnt).Value & skust
        Next cnt
        If skust = AlphaNumericOnly(skust) Then
            Range("H12:H" & gvar_itemcount).Copy
            Range("C12").PasteSpecial
            GoTo 300
        End If
        Dim skus As Range
        Dim Stylestr As String
        Dim StyleDO As DataObject
        Dim sku As Range
        
        If TypeOf Selection Is Range Then Set skus = Selection
      
        Application.ScreenUpdating = False
        For Each sku In skus
            Stylestr = AlphaNumericOnly(sku.Value)
            Set StyleDO = New MSForms.DataObject
            StyleDO.SetText (Stylestr)
            StyleDO.PutInClipboard
            ActiveCell.Offset(0, -5).Activate
            ActiveCell.PasteSpecial
            StyleDO.Clear
            ActiveCell.Offset(1, 5).Activate
        Next
        Application.ScreenUpdating = True
    End If
    
300     If IsEmpty(Range("F" & CStr(f))) = True Then
            If Left(ActiveWorkbook.Name, 7) = "X W RTW" Then
                Range("F12", "F" & gvar_itemcount).Value = "Clothing (WOMEN)"
            ElseIf Left(ActiveWorkbook.Name, 7) = "X M RTW" Then
                Range("F12", "F" & gvar_itemcount).Value = "Clothing (MEN)"
            End If
        End If
    
    If IsEmpty(Range("I" & CStr(f))) = True Then
        Range("I12", "I" & gvar_itemcount).Value = "Afghanistan"
    End If
    If IsEmpty(Range("P" & CStr(f))) = True Then
        Range("P12", "P" & gvar_itemcount).Value = "Artificial"
    End If
    If IsEmpty(Range("Q" & CStr(f))) = True Then
        Range("Q12", "Q" & gvar_itemcount).Value = "Artificial->Acetate"
    End If
    
    
    
    longer = 0
    
    End Sub
EDIT
Sorry, forgot to mention that I'm using Excel 2010 if that makes any difference.
 
Last edited by a moderator:

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

Forum statistics

Threads
1,213,536
Messages
6,114,207
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top