I have a spreadsheet"ProductIDList" and many other spreadsheets. With "ProductIDList",column A is product name and column B is productID. I want to insert the productID to column C of other spreadsheets by matching the Product name in "ProductIDList" and other spreadsheets.
I compose this code but it cannot run.
Please help :-(
Sub InsertProductID()
Dim ws As Worksheet
Dim i As Integer
Dim k As Integer
For Each ws In Worksheets
If ws.Name = "index" Or ws.Name = "ProductIDList" Then GoTo NEXXT
NEXXT:
ws.Activate
For i = 1 To 30000
For k = 1 To 30000
If ws.Cells(i, 2).Value = Sheets("ProductIDList").Cells(k, 1) Then
ws.Cells(i, 3).Value = Sheets("ProductIDList").Cells(k, 2).Value
End If
Next
Next
Next
End Sub
I edited my code. It can run now! But as what you guys said, it runs very very slow.
Sub InsertProductID()
Dim ws As Worksheet
Dim i As Integer
Dim k As Integer
For Each ws In Worksheets
If ws.Name <> "index" And ws.Name <> "ProductIDList" Then
ws.Activate
For i = 1 To 70
For k = 1 To 70
If ws.Cells(i, 2).Value = Sheets("ProductIDList").Cells(k, 1) Then
ws.Cells(i, 3).Value = Sheets("ProductIDList").Cells(k, 2).Value
End If
Next
Next
End If
Next
End Sub
I think that this code will run really slow.
In particular, I don't understand the meaning of following two lines:
If ws.Name = "index" Or ws.Name = "ProductIDList" Then GoTo NEXXT
NEXXT:
If your goal is to skip the sheets named "ProductIDList" and "index", you have - at least - to put your NEXXT label just before the last Next statement. In general, I would avoid to use unconditional jumps, anyway.
What about trying to use some formula functions, like VLOOKUP? In general, they are much faster, but I don't know the requirements of your application.
Related
I am trying to build a code to check for two conditions simultaneously from my data file. Currently my script works fine because its only checking for the brand name on column A. However I also want to check for the category on column B whether its a "Sun" or "Vista".
Structurally I want something like:
For i = 2 to Last_row
If Cells(i,1).value = "BananaRepublic" and Cells(i, 2).value = "Sun" or "Vista" then,
Row(i).Copy
Worksheet(new_worksheet).Paste
Please note: on an average there are over 30 different brands that I need to enter in this list which need to be matched with their value on column B(Sun/Vista) and I then need to replicate this for 20 different macros each for a different combination of brand names and Sun/Optical category. Doing it individually seems very inefficient. Is there a better solution?
Here's what I've done so far:
Option Compare Text
Sub StarOptical()
'Define all variables
Dim customer_name As String
Dim sheetName As String
sName = ActiveSheet.Name
'ActiveWorkbook.Worksheets(sName).Sort.SortFields.Clear
'Enter the Customer Name here
customer_name = "StarOptical"
Sheets.Add.Name = customer_name
'Copy same header to the new worksheet
Worksheets(sName).Rows(1).Copy
Worksheets(customer_name).Cells(1, 1).Select
ActiveSheet.Paste
'Find the last row of the report
last_row = Worksheets(sName).Cells(Rows.Count, 1).End(xlUp).Row
'Start the loop and scan through each row for listed brands
For i = 2 To last_row
'Update the names of the approved brands in the line below
If Worksheets(sName).Cells(i, 1).Value = "ADENSCO" Or Worksheets(sName).Cells(i, 1).Value = "BANANAREPUBLI" Or Worksheets(sName).Cells(i, 1).Value = "BOSS(HUB)" Then
Worksheets(sName).Rows(i).Copy
Worksheets(customer_name).Activate
last_row_new = Worksheets(customer_name).Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(customer_name).Cells(last_row_new + 1, 1).Select
ActiveSheet.Paste
End If
Next
Application.CutCopyMode = False
Worksheets(customer_name).Cells(1, 1).Select
End Sub
You can do something like this:
Sub tester()
CreateSheet "BananaRepublic", Array("Sun", "Vista")
'etc for other sheets
End Sub
Sub CreateSheet(sBrand As String, arrVals)
Dim wsSrc As Worksheet, wsDest As Worksheet, i As Long, c As Range
Set wsSrc = ActiveSheet
Set wsDest = wsSrc.Parent.Sheets.Add()
wsDest.Name = sBrand
wsSrc.Rows(1).Copy wsDest.Cells(1, 1)
Set c = wsDest.Cells(2, 1)
For i = 2 To wsSrc.Cells(Rows.Count, 1).End(xlUp).Row
'match on ColA?
If wsSrc.Cells(i, 1).Value = sBrand Then
'match on colB ?
If Not IsError(Application.Match(wsSrc.Cells(i, 2).Value, arrVals, 0)) Then
wsSrc.Rows(i).Copy c 'copy the row
Set c = c.Offset(1, 0) 'next cell down for copy destination
End If
End If
Next
End Sub
I have the following code, and I need to make the inserted text bold. How do I add this to my statement (can't figure out the syntax)? Thanks!
Dim ws As Worksheet
Dim addme As Long
Set ws = Worksheets("Projects")
addme = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
' Insert data from UserForm into Columns 2 & 3
With ws
ws.Cells(addme, 2).value = Me.SuperProject1.value 'the number 2 here represents the Column B
ws.Cells(addme, 3).value = Me.SProjectName1.value 'the number 3 represents Column C
End With
With ws
.Cells(addme, 2).value = Me.SuperProject1.value
.Cells(addme, 3).value = Me.SProjectName1.value
.Cells(addme, 2).Resize(1, 2).Font.Bold = True
End With
I'm trying to match name data from 2 different worksheet and from 2 different workbook. And I'm already create macros vba. But this macros is for the data type when the data is in the same order, how if the data isn't in the same order?
example of the name data
In first workbook
Name
Andre
Renata
Marie
In second workbook
Name
Andre
Marie
Renata
Using my macros the result for above data is NOT MATCH. But I want the result for above data is MATCH.
and this is my macros vba
Sub matchdata_Click()
Dim rng1 As Range, rng2 As Range
Dim iRow As Long
Dim diffs As String
With Workbooks("A.xls").Worksheets("1")
Set rng1 = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With
With Workbooks("B.xlsx").Worksheets("1")
Set rng2 = .Range("M3", .Cells(.Rows.Count, "M").End(xlUp))
End With
For iRow = 1 To WorksheetFunction.Max(rng1.Rows.Count, rng2.Rows.Count)
If rng1(iRow) <> rng2(iRow) Then diffs = diffs & iRow & vbLf
Next
If diffs <> "" Then
MsgBox "Different name in rows:" & vbCrLf & vbCrLf & diffs
Else
MsgBox "All names match"
End If
Kindly help me if you know how to do it
a small possible solution without ranges (and the cells' coodinates can be changed according to your needs):
Option Explicit
Sub check()
Dim i As Integer, j As Integer
Dim found As Boolean
i = 1
While Workbooks("A.xls").Sheets(1).Cells(i, 1).Value <> ""
j = 1
found = False
While Workbooks("B.xls").Sheets(2).Cells(j, 13).Value <> ""
If Workbooks("A.xls").Sheets(1).Cells(i, 1).Value = Workbooks("B.xls").Sheets(2).Cells(j, 13).Value Then found = True
j = j + 1
Wend
If found = False Then
Workbooks("A.xls").Sheets(1).Cells(i, 1).Interior.ColorIndex = 3
End If
i = i + 1
Wend
End Sub
I have data in about 50 sheets and structure for all of them are same. Please find data structure in an example below, in column May will be data and in next column letter for example "B" or "AB". I want to merge those two columns in one, so my data shold looks like 236AB. My code should work for all columns in sheets, because in some sheets I have 5 columns and in another 25. Anybody can help me with this one? Thank so much!
I have attach code for your requirement, It will automatically search for May and June keyword and will perform concatenation for that particular columns alone.
Sub test()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim Ws As Worksheet
Dim monthss(12) As String
monthss(1) = "May"
monthss(2) = "June"
monthss(3) = "August"
For Each Ws In wb.Worksheets
For j = 1 To 3
With Ws.UsedRange
Set c = .Find(monthss(j), LookIn:=xlValues)
If Not c Is Nothing Then
firstrow = c.Row
firstcol = c.Column
End If
End With
Set c = Nothing
lastrow = Ws.Cells(Ws.Rows.Count, firstcol).End(xlUp).Row
' For May Sheet
If firstrow > 0 Then
For i = firstrow + 1 To lastrow
Ws.Cells(i, firstcol).Value = Ws.Cells(i, firstcol).Value & Ws.Cells(i, firstcol + 1).Value
Next
firstrow = 0
End If
' for June Sheet
Next j
Next Ws
End Sub
Not 100% sure what your end goal is but could you not add a new column on the left and make it's formula be CONCATENATE(A1:E1) and make it go as far down the sheet as you need it?
Then if you need to afterwards you could copy paste values that column and delete the others.
All fairly quick to do even if recording in excel.
Do you want to give that a go and post back if you get stuck?
Here is a Function that merges 2 Columns together:
Function mergeColumns(mergeColumn As Integer)
Dim i As Integer
'Adjust startvalue(1)
For i = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row Step 1
'Combine mergeColumn and Column next to it
Cells(i, mergeColumn).Value = Cells(i, mergeColumn).Value & Cells(i, mergeColumn + 1).Value
'Clear the Content of the Cell next to Mergecolumn
Cells(i, mergeColumn + 1).Value = ""
Next i
End Function
Lets say you want to merge column A and B, the call would be mergeColumns 1
Now work out a routine to find the right columns to merge.
I'm trying to run a simple nested If & Do Until loop for multiple sheets:
Sub DoUntil()
Dim ws As Worksheet
Dim i As Integer
For Each ws In ActiveWorkbook.Worksheets
For i = 1 To 25
If ws.Cells(i, 10) = "T" Then
ws.Cells(i, 10).Select
Do Until ActiveCell = "P"
ActiveCell.Offset(1, 1) = 1
ActiveCell.Offset(1, 0).Select
Loop
End If
Next i
Next ws
End Sub
PURPOSE: This function is meant to loop through a column, and place 1's in the next column to the right. The 1's must start just after "T" and end at "P". The T's and P's are unevenly spaced.
PROBLEM: Running this code for a single worksheet without the ws. object gives no problem. However, as soon as I want to loop through multiple worksheets, the .Select fails to fetch the specified range (Error 1004). This error is given at
ws.Cells(i, 10).Select
QUESTION: I know the perils of using the .Select property, but I'm unsure of how to tackle this problem differently as the ActiveCell is crucial for my Do Until function. Is there another way to run my Do Until function that will work with the If statement and loop through multiple sheets?
Try the below:
Sub DoUntil()
Dim ws As Worksheet
Dim i As Integer, j as Integer
For Each ws In ActiveWorkbook.Worksheets
For i = 1 To 25
If ws.Cells(i, 10) = "T" Then
j = i
Do Until ws.Cells(j,10) = "P"
ws.Cells(j, 10+1) = 1
j = j + 1
Loop
End If
Next i
Next ws
End Sub
use match, something like
cells(match("T",range("a1:a50000"),0),1) to
cells(match("P",range("a" & match("T",range("a1:a50000"),0) & ":a50000"),0),1)
and something like
range(cells(y,x),cells(y2,x2)).offset(0,1).value=1