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.
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'm having trouble combing MULTIPLE sheets (can be more than 2 sheets) in one.
Basically I have sheets with same column what I want is to combine them.
Example: This is just a scenario but can we have a dynamic code for more than 2 sheets, the Unique ID can be shuffle. But basically this is what I'm trying to achieve (output), combining the data on different sheets in one.
I tried to use the ADO and make query for UNION and INNER JOIN (because I think it will work) but no luck.
Hope anyone can help me.
Try this.
Sub test()
Dim vDB, Temp
Dim Ws(1 To 3) As Worksheet
Dim i As Long, j As Integer
Set Ws(1) = Sheets("Sheet1")
Set Ws(2) = Sheets("Sheet2")
Set Ws(3) = Sheets("Output")
vDB = Ws(1).Range("a1").CurrentRegion
Temp = Ws(2).Range("a1").CurrentRegion
For i = 2 To UBound(vDB, 1)
For j = 2 To UBound(vDB, 2)
If Temp(i, j) <> "" Then
vDB(i, j) = Temp(i, j)
End If
Next j
Next i
Ws(3).Range("a1").Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
End Sub
Sub SheetCode()
For Each sh In Sheets
If sh.Name <> Name Then
For Each cl In sh.Range("B2:D4")
If cl.Value <> "" Then Range(cl.Address).Value = cl.Value
Next
End If
Next
End Sub
This code assumes the tables are exactly identical in all sheets i.e. Headers & Unique IDs are in the same sequence.
Paste the code in Sheet where you want the data to be collected.
I am very new to VBA. Just started reading it up 2 days ago. I am wondering how could I write a VB codes assigned to a button to read through the whole column and search for similar numbers.
After that identifying similar numbers, it would need to move on to another column to check if the character in the column are same too.
If both of the logic = true . How can i change the cell of the value of another column?
Sample data
For the current example. The code should know that the first column had matching numbers. After that it will check for the name which is "a" in the example. After that it will automatically change the point to 1 and 0. If there are 3 same ones it will be 1,0,0 for the point
You may try recording whatever you want to do with record macros first, then filter out the codes that are not necessary. If you do not know how to record it using macros, click on the link below. You can learn from the recorded macros and slowly improvise your codes in the future from the experience you may gain.
Here's [a link] (http://www.dummies.com/software/microsoft-office/excel/how-to-record-a-macro-in-excel-2016/)
As per image attached in image I am assuming numbers are in Column A, column to check characters is Column J and result needs to be displayed in Column O then try following code.
Sub Demo()
Dim dict1 As Object
Dim ws As Worksheet
Dim cel As Range, fCell As Range
Dim lastRow As Long, temp As Long
Dim c1
Set dict1 = CreateObject("Scripting.Dictionary")
Set ws = ThisWorkbook.Sheets("Sheet2") 'change Sheet2 to your data sheet
With ws
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'last row with data in Column A
c1 = .Range("A2:A" & lastRow)
For i = UBound(c1, 1) To 1 Step -1 'enter unique values with corresponding values in dict1
dict1(c1(i, 1)) = .Range("J" & i + 1) '+1 for Row 2
Next i
Set fCell = .Range("A2")
For Each cel In .Range("A2:A" & lastRow) 'loop through each cell in Column A
temp = WorksheetFunction.CountIf(.Range(fCell, cel.Address), cel) 'get count
If temp > 1 Then
If cel.Offset(0, 9) = dict1(cel.Value) Then
cel.Offset(0, 14).Value = 0
Else
cel.Offset(0, 14).Value = 1
End If
Else
cel.Offset(0, 14).Value = 1
End If
Next cel
End With
End Sub
EDIT
Sub Demo()
Dim ws As Worksheet
Dim lastRow As Long
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Sheet2") 'change Sheet3 to your data range
With ws
lastRow = .Cells(.Rows.count, "A").End(xlUp).Row 'last row with data in Column A
.Range("O2").Formula = "=IF(MOD(SUMPRODUCT(($A$2:$A2=A2)*($J$2:$J2=J2)),3)=1,1,0)" 'enter formula in Cell O2
.Range("O2").AutoFill Destination:=.Range("O2:O" & lastRow) 'drag formula down
.Range("O2:O" & lastRow).Value = .Range("O2:O" & lastRow).Value 'keep only values
End With
Application.ScreenUpdating = True
End Sub
My desired result is to have a separate column at column C, that has values only.
In Column "I" I have a range of data that is in in formulas. I can copy and paste special to a new column to C and that gives me the values only.
But is there a better way to do this? When I read data in New Column C, this gives the range of the pasted data which is messy meaning lots of white spaces.
Thanks :)
Sub Macro2()
'
' Macro2 Macro
'
Sheets("Sheet1").Columns(9).Copy
Sheets("Sheet1").Columns(3).PasteSpecial xlPasteValues
End Sub
Please test.
S1: Select sheet contain data you want to copy
S2: run macro
Sub macro1()
Dim data As Variant
data = ActiveSheet.Columns(9)
ActiveSheet.Columns(3) = data
End Sub
if all of your data is number then just force is to convert to number
Sub macro1()
Dim data As Variant
data = ActiveSheet.Columns(9)
Dim i As Long
For i = LBound(data) To UBound(data)
If Len(data(i, 1)) > 0 Then
data(i, 1) = CLng(data(i, 1))
End If
Next i
ActiveSheet.Columns(3) = data
End Sub
edited as you want to copy the whole column
p/s: this is not an optimize solutio as it read the whole column (1048576 rows)
If you are interested in copying only values, you can do it like this:
Step 1: determine last row in column I: lastRow = Cells(1, 9).End(xlDown).Row.
Step 2: copy all values to column C:
For i = 1 To lastRow
Cells(i, 3).Value = Cells(i, 9).Value
Next i
Putting it all together, the macro is:
Sub CopyPaste()
Dim lastRow, i As Long
lastRow = Cells(1, 9).End(xlDown).Row
'alternatively specify explicitly amount of rows you want to copy, i.e.:
'lastRow = 25
For i = 1 To lastRow
Cells(i, 3).Value = Cells(i, 9).Value
Next i
End Sub
I'm fairly new to VBA. I'm currently trying to find a faster way to copy and paste information by using Macros. I'm not sure how to code this.
I have two columns I want to use with a For Each loop.
I wanted to loop through each row of these two columns and use an If function. If the first row has a value in Column B (Column B cell <> "" Or Column B cell <> 0) then, select that row (i.e. Range("A1:B1")).
After the loop, I will copy whatever is selected and paste it to a specific row.
However, I want to keep adding to that selection as it loops through each row and only if it satisfies the If condition, so I'm able to copy it all once at the end. How do I go about combining this?
A B
1 Abc 1
2 Def 2
3 Geh 3
This is how you can expand current selection:
Sub macro1()
Set selectedCells = Cells(1, 2)
Set selectedCells = Application.Union(selectedCells, Cells(2, 3))
selectedCells.Select
End Sub
I'm sure you can manage the rest of your code by yourself, it's really easy. You already mentioned everything you need: For Each cell In Range("B1:B5") and If statement
Please try the below code
Sub test()
Application.ScreenUpdating = False
Dim rng As Range, one As Variant
Dim i As Integer
'Change the sheet and range name as yours
'Finding lastrow of destination column
i = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row + 1
' getting input from user
Set rng = Application.InputBox("Please select a range of cells!", "Please select a range", Selection.Address, , , , , 8)
For Each one In rng
If one.Value <> "" Or one.Value <> 0 Then
Range(one.Offset(0, -1), one).Copy
'Change the sheet and range name as yours
Sheets("Sheet2").Activate
Range("A" & i).Select
ActiveSheet.Paste
i = i + 1
End If
Next one
Application.ScreenUpdating = True
End Sub
The above macro will prompt you for the input range to be validate and copy to sheet2 in column A.
The below code will validate and copy paste the current selected range to sheet2 column A
Sub test()
Application.ScreenUpdating = False
Dim rng As Range, one As Variant
Dim i As Integer
'Chnage the sheet and range name as yours
'Finding lastrow of destination column
i = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row + 1
' getting input from user
Set rng = Selection
For Each one In rng
If one.Value <> "" Or one.Value <> 0 Then
Range(one.Offset(0, -1), one).Copy
'Chnage the sheet and range name as yours
Sheets("Sheet2").Activate
Range("A" & i).Select
ActiveSheet.Paste
i = i + 1
End If
Next one
Application.ScreenUpdating = True
End Sub
I think you're probably going about this the wrong way. Do you already know to where you would like to copy all the data in the end? It sounds like it, as you refer to copying it "to a specific row". If so, you'd be better off using your macro to copy the data from Columns A:B on the fly.
So, for example:
Sub CopyData()
Const SOURCE_COLUMN1 As Long = 1 ' A
Const SOURCE_COLUMN2 As Long = 2 ' B
Const TARGET_COLUMN1 As Long = 5 ' E
Const TARGET_COLUMN2 As Long = 6 ' F
Dim lngSourceRow As Long
Dim lngTargetRow As Long
With ThisWorkbook.Sheets("Sheet1")
lngSourceRow = 1
lngTargetRow = 0 ' Change this to the row above the one you want to copy to;
Do While .Cells(lngSourceRow, SOURCE_COLUMN1) <> ""
If .Cells(lngSourceRow, SOURCE_COLUMN2) <> "" Then
lngTargetRow = lngTargetRow + 1
.Cells(lngTargetRow, TARGET_COLUMN1) = .Cells(lngSourceRow, SOURCE_COLUMN1)
.Cells(lngTargetRow, TARGET_COLUMN2) = .Cells(lngSourceRow, SOURCE_COLUMN2)
End If
lngSourceRow = lngSourceRow + 1
Loop
End With
End Sub