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.
EDIT
Sorry, forgot to mention that I'm using Excel 2010 if that makes any difference.
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 SubSorry, forgot to mention that I'm using Excel 2010 if that makes any difference.
Last edited by a moderator:
