I need an Excel macro to join seven columns of data on each row until the end of the data is reached. For example if I have a formula like this:
=A1&B1&C1&D1&E1&F1&G1
How can I write the macro so that it increments for every row to the end of the file in a sequence like this?
=A1&B1&C1&D1&E1&F1&G1
=A2&B2&C2&D2&E2&F2&G2
=A3&B3&C3&D3&E3&F3&G3
With so many answers, the main focus on what assylias and I were highlighting has gone to waste :)
However, if you still want a VBA answer. Use this method. This is much faster than Looping or an Autofill.
Option Explicit
Sub Sample()
Dim LastRow As Long
Dim Ws As Worksheet
Set Ws = Sheets("Sheet1")
LastRow = Ws.Range("A" & Ws.Rows.Count).End(xlUp).Row
'~~> If your range doesn't have a header
Ws.Range("H1:H" & LastRow).Formula = "=A1&B1&C1&D1&E1&F1&G1"
'~~> If it does then
Ws.Range("H2:H" & LastRow).Formula = "=A2&B2&C2&D2&E2&F2&G2"
End Sub
If you have 1000's of rows then you might want to switch off Screenupdating and change Calculation to Manual before you run the code and then reset them at the end of the code.
I think the easiest way to do this would be to just fill down as assylias says but if you want to use VBA:
Selection.AutoFill Destination:=Range("Your Fill Range"), Type:=xlFillDefault
Should copy across the other rows.
I agree 100% with the comments and the other answers, why do you need VBA to do this, but just to answer your original question, this is how I would accomplish it:
Sub FillAllWithFormula()
Dim i As Variant
Dim wsht As Worksheet
'If you are using this for a specific Worksheet use the following
Set wsht = ThisWorkbook.Worksheets(yourWorksheetName)
'or if you are always using this for the active sheet use the following
Set wsht = ActiveSheet
For i = 1 To wsht.Rows.Count
'Replace "X" with the column letter you want your formula to appear in
wsht.Range("X" & i).Formula = "=A" & i & "&B" & i & "&C" & i & "&D" & i & "&E" & i & "&F" & i & "&G" & i
Next
Set wsht = Nothing
End Sub
Related
I have written a vba code to find match in dynamic column "F" with cell value i cell "i1". And when match found in the column " F" it will clear the content of the particular row.
The VBA is working fine in the excel marco where I have written the VBA code but to my surprise when I copy the same VBA code to a different excel macro having the same content in worksheet and run the VBA code it does not clear all the match content row i.e., it clear some of the match row leaving some of match row uncleared. Where I am doing the mistake?
Sub test()
Dim i as long
For i = 100 To 1 step -1
If Range("F" & i).Value = Range("i1").Value Then Rows(i).EntireRow.ClearContent
Next i
End Sub
IMHO you just have to fix your typo and copy the code into a module (not the worksheet or workbook module) and it will work on the active sheet.
Sub test()
Dim i As Long
For i = 100 To 1 Step -1
If Range("F" & i).Value = Range("i1").Value Then
Rows(i).EntireRow.ClearContents
End If
Next i
End Sub
Rows(i) and Range("F" & i) is defined implicitly which might refer to another sheet or even another workbook.
below is a sample code with use of sheet reference.
Dim i as long
Dim ws as Worksheet
Set ws = ThisWorkBook.Sheets("YourSheetName")
For i = 100 To 1 step -1
If ws.Range("F" & i).Value = ws.Range("i1").Value Then ws.Rows(i).EntireRow.ClearContents
Next i
I was searching around this forum for quite a long time and learned quite a bit. However, I have a problem now which is easy to fix, I guess, but I am too blind to see the right solution.
I have a sheet with over 50k rows which also contain a number for suppliers, so these numbers happen to be duplicates.
I got a vba macro which creates a new sheet for every supplier number without duplicates, so thats not the problem.
However, I want to copy the data of the row to the worksheet which is equal to the supplier number appearing in that row.
The supplier numbers are in column A. So, if Row 2 has supplier number 10 then copy the row to sheet "10", Row 3 has number 14 to sheet "14", Row 4 has number 10 to sheet "10" again and so on.
I used the following code I found here and remodeld it a bit.
Sub CopyRows()
Dim DataSht As Worksheet, DestSht As Worksheet
Set DataSht = Sheets("All Data")
RowCount = DataSht.Cells(Cells.Rows.Count, "A").End(xlUp).Row
For i = 2 To RowCount
DataSht.Range("A" & i).EntireRow.Copy
Set DestSht = Sheets(DataSht.Range("A" & i).Value)
DestLast = DestSht.Cells(Cells.Rows.Count, "A").End(xlUp).Row
DestSht.Range("A" & DestLast + 1).Paste
Next i
End Sub
However it get an subscript out of range error on this line:
Set DestSht = Sheets(DataSht.Range("A" & i).Value)
Try this:
For i = 2 To RowCount
Set DestSht = Sheets(CStr(DataSht.Range("A" & i)))
DestLast = DestSht.Cells(Cells.Rows.Count, "A").End(xlUp).row
DataSht.Range("A" & i).EntireRow.Copy Destination:=DestSht.Range("A" & DestLast + 1)
Next I
Since:
with CStr function it points to Sheets("12")
while Cstr it'd point to Sheets(12), i.e. the twelfth sheet in the workbook, which could not be the one you'd want or neither be there.
This error is caused because Excel can't identify a sheet with the same name as your column A value. You might want to run this small sub to see if it gives you a clue as to why...
Sub SheetNamesAndIndexes()
DIm ws as Worksheet
For Each ws in ThisWorkbook.Sheets
Debug.print ws.Name & ";" & ws.Index
Next
End Sub
This will show you the names and the indexes of all your sheets. If that doesn't reveal the problem, you can take this and incorporate it into your code to help you debug, like so...
Dim ws as Worksheet
For i = 2 To RowCount
For Each ws in ThisWorkbook.Sheets
Debug.Print ws.Name * ";""" & DataSht.Range("A" & i).Value & """;" & ws.Name = DataSht.Range("A" & i).Value
Next
...
This will put the value of each cell in Col A next to each sheet name, along with whether or not Excel thought the two matched. If you see one that says "False" that you expect to be "True", investigate that next. I've put quotes around the DataSht.Range.Value to make it more obvious if you've got extra spaces, etc.
If that doesn't yield answers, another answer suggested making sure that you're not comparing strings to integers. If that's the case, then wrap your Range.Value in a Cstr() and run it again. Good Luck!
I am trying to replace the value in a cell so if it has 0 to hide it.
The excel formula is the following IF(A1=0;"";A1).
I am trying to this automaticaly but I am having problems.
So far I came up with this:
Sub apply_Error_Control()
Dim cel As Range
For Each cel In Selection
If cel.HasFormula Then
cel.Formula = Replace(cel.Formula, "=", "=IFF(") & "=0" & ";" & "")"
End If
Next cel
End Sub
Give this link a view:
Three ways to hide zero values
I'd still strongly recommend going down the cell formatting route:
Sub apply_Error_Control()
Dim rngCurrent As Range
If TypeName(Selection) = "Range" Then
Set rngCurrent = Selection.SpecialCells(xlCellTypeFormulas)
rngCurrent.NumberFormat = "0;-0;;#"
End If
End Sub
But if you insist on the formula-based approach, please at least employ the method I've outlined so that you avoid running the code on (for example) an embedded chart or button and you'll immediately hit those cells with a formula - looping through to find those with a formula is tedious and slow.
Give this a try (note the Selection.Cells so it'll only work in the Range that you selected manually) :
Sub apply_Error_Control()
Dim cel As Range, _
RangeInForumla As String
For Each cel In Selection.Cells
If cel.HasFormula Then
RangeInForumla = Replace(cel.Formula, "=", "",1,1)
cel.Formula = "=IF(" & RangeInForumla & "=0," & Chr(34) & Chr(34) & "," & RangeInForumla & ")"
End If
Next cel
End Sub
I'm new to VBA and I have recently been creating a few macros. I currently have one that works, but it isn't very cooperative at times. I've done a bunch of reading on how to optimize VBA code, but I'm still not getting very far. I understand using Select is bad, and I've removed as much of the Select lines as I could on my own. I've also read that many if statements combined with loops can be hard to run as well (of course I have multiples of both).
So I know some of the reasons why my code is bad, but I don't really know how to fix it. I added
Application.ScreenUpdating = False
Application.ScreenUpdating = True
to my macro as well. This has helped, but not much. I have other macros that can run for a long time and never freeze up. This macro freezes if it doesn't finish in 10-15 seconds. If I only have a couple 100 rows of data it runs no problem. If I have a few 1000 lines of data it doesn't finish before it freezes.
Option Explicit
Sub FillGainerPrices()
Application.ScreenUpdating = False
'Search each name on "Gainer Prices" and if the same name is on "Gainers", but not on Gainer Prices _
move it over to Gainer Prices tab. Then call Historical Query and Fill Names
Dim LastRow1 As Long
LastRow1 = Sheets("Gainers").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim LastRow2 As Long
LastRow2 = Sheets("Gainer Prices").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim Name1 As Range
Dim Name2 As Range
For Each Name1 In Sheets("Gainers").Range("B2:B" & LastRow1)
Set Name2 = Sheets("Gainer Prices").Range("A2:A" & LastRow2).Find(Name1, LookIn:=xlValues, LookAt:=xlWhole)
If Name2 Is Nothing Then
If Name1.Offset(0, -1) < Date - 15 Then
Name1.Copy
Sheets("Gainer Prices").Select
Range("C" & Cells.Rows.Count).End(xlUp).Offset(1, -2).Select
ActiveSheet.Paste
Call HistoricalQuery
End If
End If
Next Name1
Application.ScreenUpdating = True
'Fill in Names and remaining symbols here
Call FillNamesAndSymbols
End Sub
Call HistoricalQuery and Call FillNamesAndSybmols are pretty quick and do not seem to have any issues when I run them by themselves so I don't think they are causing the problem. I'm guessing the issue is searching for one Name 1000's of times and then copying and pasting over and over, but I can't figure out how to get rid of the copy and paste part without the macro giving me wrong results.
The end goal of the macro is to go to the 2nd sheet and see if those names are on the first sheet. If not, it moves the names over, and then for each name it moves over it calls another macro to pull historical data for that name. Finally at the end it just does some formatting and filling in or deleting of blank cells. If anyone can direct me in the correct direction I would appreciate it. Thanks!
Try this code.
Improvments:
Timing: my code: 0.8828125 sec, your code: 10.003 sec. (tested with 1000 rows in both sheets)
I'm using array to store values from second sheet: arr = Sheets("Gainer Prices").Range("A2:A" & LastRow2).Value - much faster for huge data
I'm using Application.Match instead Range.Find - it's faster as well.
I'm using Range(..).Value = Range(..).Value instead copy/paste
avoid using select/active statement
Sub FillGainerPrices()
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim Lastrow3 As Long
Dim Name1 As Range
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim arr As Variant
'remember start time
Dim start as Long
start = Timer
Application.ScreenUpdating = False
Set sh1 = ThisWorkbook.Sheets("Gainers")
Set sh2 = ThisWorkbook.Sheets("Gainer Prices")
With sh1
LastRow1 = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
With sh2
LastRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row
arr = .Range("A2:A" & LastRow2).Value
End With
For Each Name1 In sh1.Range("B2:B" & LastRow1)
If IsError(Application.Match(Name1.Value, arr, 0)) Then
If Name1.Offset(0, -1) < Date - 15 Then
With sh2
Lastrow3 = .Cells(.Rows.Count, "C").End(xlUp).Row
.Range("A" & Lastrow3 + 1).Value = Name1.Value
End With
Call HistoricalQuery
End If
End If
Next Name1
'Fill in Names and remaining symbols here
Call FillNamesAndSymbols
Application.ScreenUpdating = True
'To see timing result press CTRL+G in the VBE window, or change Debug.Print to MsgBox
Debug.Print "Code evaluates for: " & Timer - start
End Sub
instead of
Name1.Copy
Sheets("Gainer Prices").Select
Range("C" & Cells.Rows.Count).End(xlUp).Offset(1, -2).Select
ActiveSheet.Paste
you might try something like this:
Name1.copy destination:=Sheets("Gainer Prices").Range("C" & Cells.Rows.Count).End(xlUp).Offset(1, -2)
or perhaps
Sheets("Gainer Prices").Range("C" & Cells.Rows.Count).End(xlUp).Offset(1, -2).value=Name1.value
I am trying to set the range in For loop. My code works fine when I do this:
For Each i in Range("A1":"A5")
'Some process code
Next i
But I do not get the same results when I do this:
For Each i in Range("A1").End(xlDown)
'Some Process
Next i
Arent the two codes equivalent? What changes should I make to the second one that it perfoms the same way as the first one but doesn't make me hardcode the Range in the code?
The second one you have only gets the last cell in the range, which I believe would me A5 from the first example. Instead, you need to do something like this.
I structured this like a small test so you can see the first option, the corrected second, and an example of how I would prefer to do this.
Option Explicit
Sub test()
Dim r As Range
Dim x As Range
' Make sure there is stuff in Range("A1:A5")
Range("A1") = 1
Range("A2") = 2
Range("A3") = 3
Range("A4") = 4
Range("A5") = 5
' Your first option
For Each x In Range("A1:A5")
Debug.Print x.Address & ", " & x
Next
' What you need to do to get the full range
For Each x In Range("A1", Range("A1").End(xlDown))
Debug.Print x.Address & ", " & x
Next
' My preferred method
Set r = Range("A1").End(xlDown)
For Each x In Range("A1", r)
Debug.Print x.Address & ", " & x
Next
End Sub
The cleanest way to do it would probobly be to store the lastRow number in a variable like so. You can do the concatenation in the for each line:
Dim cell as range
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).row
For Each cell In Range("A1:A" & lastRow)
Please note that it makes a difference between using xlUp and xlDown.
xlUp gives you last cell used in column A (so you start at rows.count)
XlDown gives you last non-blank cell (you can use range("A1").End(xlDown).Row)
You'll notice a lot of people use "A65536" instead of rows.count, but 65536 is not the limit for some versions of Excel, so it's always better to use rows.count.