My goal is to rename many worksheets from a worksheet that contains stock market codes. To do this I have the codes in a worksheet called Update. The codes are from A2 to A10. I have set up a For loop to goto the next activeworksheet and as the range value is increased, the worksheet gets renamed to the new cell value in the Update WSheet
The problem I have is that I want the Range value to increase by 1 which will select the next name for the worksheet. I have tried adding 1 to the Range value but did not work
Sub changeWSnames()
Dim sheetname As Worksheet
Dim r As Integer
For r = 1 To 10
ActiveWorkbook.Worksheets(r).Activate
Set sheetname = ActiveWorkbook.ActiveSheet
sheetname.Name = Worksheets("Update").Range("a2").Value
Next r
r = r + 1
End Sub
What I need is too workout is how to increment the .Range("a2").Value , i.e. to increase by 1, example it becomes Range("a3").Value etc etc.
Replace:
sheetname.Name = Worksheets("Update").Range("a2").Value
with:
sheetname.Name = Worksheets("Update").Range("a" & (r+1)).Value
So the first time through the loop we use a2, the next time we use a3, etc.
Related
I'm currently working on a project on VBA that requires multiple manipulation on data.
So, the main idea of this will be to get the data that I have on "Q1" and paste it 4 times on A (starting at the first blank cell), after that, take the data from "Q2" and do the same until there is no more data on the "Q" column. After there is no more data, the process should stop.
Later on I may need to modify the process, so the value gets pasted only 2 or 3 times instead of 4.
Something like this:
Column Q data:
Expected result:
I think this will do what you want:
Option Explicit
Sub Transpose_Multiplied()
Dim Number_Of_Repetitions As Integer
Dim Input_Column As String
Dim Output_Column As String
' -----------------------------------------------------------
' These are the control variables ....
Number_Of_Repetitions = 4
Input_Column = "Q"
Output_Column = "A"
' -----------------------------------------------------------
Dim WSht As Worksheet
Dim Cell As Range
Dim LastACell As Long
Dim i As Integer
Set WSht = ActiveWorkbook.ActiveSheet
For Each Cell In WSht.Range(Input_Column & "2:" & Input_Column & WSht.Cells(WSht.Rows.Count, Input_Column).End(xlUp).Row)
For i = 1 To Number_Of_Repetitions
LastACell = WSht.Cells(WSht.Rows.Count, Output_Column).End(xlUp).Row
If LastACell = 1 And WSht.Cells(LastACell, Output_Column).Value = vbNullString Then
WSht.Cells(LastACell, Output_Column).Value = Cell.Value
Else
WSht.Cells(LastACell + 1, Output_Column).Value = Cell.Value
End If
Next
Next
End Sub
So, I open up my workbook and leave it open on the Worksheet where the data to be processed is. Then I run the macro from my PERSONAL.XLSB:
Hi this is my first post and i am newbie when it comes to VBA.
So i tried the last 6 hours to accomplish one task.
I already managed to get the code for the For each loop and it works and copies the value to the existing workbook. But i couldnt find out why it always copies the value to A2 and not further to A3/A4/A5 and so on .
I tried these piece of code " range = range + 1 " but i keep getting runtime errors and it still copies the values to A2 and overwrites it when it gets a new value from the loop.
I think its only a litte change needed but i cant figure it out. :(
Sub copie1()
Dim ws As Worksheet
Dim cell As Range
Dim targetsheet As Worksheet
Dim target As Range
Dim rngTemp As Range
Set wkba = ActiveWorkbook
Worksheets("cop1").Activate
LR = Cells(Rows.Count, "A").End(xlUp).Row
LT = Cells(Rows.Count, "X").End(xlUp).Row
Set rngTemp = Range("X2:X" & LT)
Workbooks.Open Filename:="C:\Users\path......."
Set targetsheet = Worksheets("Data")
Set target= targetsheet.Range("A1")
For Each cell In rngTemp
If cell > 0 Then
target.Offset(1, 0) = cell.Value
End If
target = target+1 '// is this right?
Next cell
End Sub
my goal is the loop through column X in a Workbook and copy every single data that is bigger than 0 ( because there are empty cells & cells with value 0)
and paste it in an existing workbook in range A2/A3/A4 and so on
You can't add the number one to a Range object.
Try replacing target = target+1 '// is this right? with:
Set target = target.Offset(1)
Does this resolve the problem?
SibSib1903, I have added below a simple example that you can easily adapt to your own requirements. It looks at all cell values in column A and any numeric value greater than zero is copied to column C starting in row 1. For example, if column A contains 45 rows with data, and only three of these rows have a numeric value greater than zero, these three values will copied in column C in the first three rows.
Public Sub copieTest()
Dim ws As Worksheet, cell As Range, rngX As Range
Dim tmpVal As Variant, counter As Long
Set ws = ThisWorkbook.Worksheets("cop1")
Set rngX = ws.Range("A1:A" & ws.Cells(ws.Rows.count, 1).End(xlUp).Row)
counter = 1
For Each cell In rngX
tmpVal = Val(Trim(cell.Value))
If tmpVal > 0 Then
ws.Range("C" & counter).Value = tmpVal
counter = counter + 1
End If
Next cell
Set rngX = Nothing: Set ws = Nothing
End Sub
I am trying to make some kind of inventory. So when on the second sheet I add a name of a certain product, it adds 1 up to the inventory I had in the first sheet in row E for that product. This for a list of names put in the 2nd sheet instead of just 1 name like tried out in the VBA code here.
After I am done with the list I should be able to clear sheet 2 and the values stay saved.
When I try this it gives an error and I just don't know how to make it work with letting it go over the entire list.
Private Sub CommandButton1_Click()
Dim x As Integer
x = Sheets("Sheet1").Cells(1, "E").Value
For Each cell In Sheets(Sheet1).Range("A:A")
If cell.Value = Sheets("Sheets2").Cells(1, "A").Value Then
x = x + 1
End If
Next cell
End Sub
You are thinking that x represents the cell, but it is a memory variable that starts with the Value in E1 on Sheet1.
If you want the range to increase then make the variable a range and set it to the range desired, or skip that all together:
Private Sub CommandButton1_Click()
Dim cell as Range
With Worksheets("Sheet1")
For Each cell In Intersect(.Range("A:A"),.UsedRange)
.Range("E1").value = .Range("E1").value + Application.WorksheetFunction.COUNTIF(Worksheets("Sheet2").Range("A:A"),cell.Value)
Next cell
End With
End Sub
Try this:
Private Sub CommandButton1_Click2()
Dim x As Integer
Dim lastRow As Long
Dim cell as Range
x = Sheets("Sheet1").Range("E1").Value
lastRow = Range("A" & Rows.Count).End(xlUp).Row ' assuming Col. A has most data
For Each cell In Sheets("Sheet1").Range("A1:A" & lastRow)
If cell.Value = Sheets("Sheets2").Range("A1").Value Then
x = x + 1
End If
Next cell
Debug.Print "x is now " & x
' Put the new value in E1
Sheets("Sheet1").Range("E1").Value = x
End Sub
I didn't do too much, just shortened the range so you don't loop through all of column A. Added Dim cell as Range, and put quotes around the Sheet1 in the For loop start. (That's where the error was coming from on that line). You can do Sheet1.Range(), or Sheets("Sheet1").Range, but not Sheets(Sheet1).Range without some additional coding/weird variable setup.
Excel 2010. I am trying to write a macro that could copy a set of data multiple times based on criteria on another sheet, but I've been stuck for a long time. I very much appreciate any help that could be offered to help me solve this problem.
Step 1: In the "Criteria" worksheet, there are three columns in which each row contains a specific combination of data. The first set of combination is "USD, Car".
Criteria worksheet
Step 2: Then the macro will move to the Output worksheet (please refer to the below link for screenshots), and then filter column A and B with the first set of criteria "USD" and "Car" in the "Criteria" worksheet.
Step 3: Afterwards, the macro will copy the filtered data into the last blank row. But the tricky part here is that, the filtered data has to be copied two times (as the "Number of set" column in the "Criteria" tab is 3 in this combination, and it doesn't have to copy the data three times since the filtered data would be treated as the first set of data)
Step4: After the filtered data have been copied, the "Set" column D will need to fill in the corresponding number of set that the rows are in. Therefore, in this 1st example, cell D2 and D8 will have "1" value, cell D14-15 will have "2" value, and cell D16-17 will have "3" value.
Step5: The macro will then move back to the "Criteria" worksheet and continue to based on the 2nd set of combination "USD, Plane" to filter the data in the "Output" worksheet. Again, it will copy the filtered data based on the "Number of set" in the "Criteria" worksheet. This process will continue until all the different combinations in the "Criteria" worksheet have been processed.
Output worksheet
Ok sorry for delay, here is a working version
you just have to add a sheet called "BF" because the autofilter count wasn't working properly so I had to use another sheet
Sub testfct()
Dim ShC As Worksheet
Set ShC = ThisWorkbook.Sheets("Criteria")
Dim EndRow As Integer
EndRow = ShC.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To EndRow
Get_Filtered ShC.Cells(i, 1), ShC.Cells(i, 2), ShC.Cells(i, 3)
Next i
End Sub
Sub Get_Filtered(ByVal FilterF1 As String, ByVal FilterF2 As String, ByVal NumberSetsDisered As Integer)
Dim NbSet As Integer
NbSet = 0
Dim ShF As Worksheet
Set ShF = ThisWorkbook.Sheets("Output")
Dim ColCr1 As Integer
Dim ColCr2 As Integer
Dim ColRef As Integer
ColCr1 = 1
ColCr2 = 2
ColRef = 4
If ShF.AutoFilterMode = True Then ShF.AutoFilterMode = False
Dim RgTotal As String
RgTotal = "$A$1:$" & ColLet(ShF.Cells(1, Columns.Count).End(xlToLeft).Column) & "$" & ShF.Cells(Rows.Count, 1).End(xlUp).Row
ShF.Range(RgTotal).AutoFilter field:=ColCr1, Criteria1:=FilterF1
ShF.Range(RgTotal).AutoFilter field:=ColCr2, Criteria1:=FilterF2
'Erase Header value, fix? or correct at the end?
ShF.AutoFilter.Range.Columns(ColRef).Value = 1
Sheets("BF").Cells.ClearContents
ShF.AutoFilter.Range.Copy Destination:=Sheets("BF").Cells(1, 1)
Dim RgFilt As String
RgFilt = "$A$2:$B" & Sheets("BF").Cells(Rows.Count, 1).End(xlUp).Row '+ 1
Dim VR As Integer
'Here was the main issue, the value I got with autofilter was not correct and I couldn't figure out why....
'ShF.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows.Count
'Changed it to a buffer sheet to have correct value
VR = Sheets("BF").Cells(Rows.Count, 1).End(xlUp).Row - 1
Dim RgDest As String
ShF.AutoFilterMode = False
'Now we need to define Set's number and paste N times
For k = 1 To NumberSetsDisered - 1
'define number set
For j = 1 To VR
ShF.Cells(Rows.Count, 1).End(xlUp).Offset(j, 3) = k + 1
Next j
RgDest = "$A$" & ShF.Cells(Rows.Count, 1).End(xlUp).Row + 1 & ":$B$" & (ShF.Cells(Rows.Count, 1).End(xlUp).Row + VR)
Sheets("BF").Range(RgFilt).Copy Destination:=ShF.Range(RgDest)
Next k
ShF.Cells(1, 4) = "Set"
Sheets("BF").Cells.ClearContents
'ShF.AutoFilterMode = False
End Sub
And the function to get column letter using an integer input :
Function ColLet(x As Integer) As String
With ActiveSheet.Columns(x)
ColLet = Left(.Address(False, False), InStr(.Address(False, False), ":") - 1)
End With
End Function
I'm a total newbie in VBA, just started this morning when confronted with a spreadsheet with ~30K rows.
I have two worksheets:
named "tohere", contains ordinal numbers in column C.
named "fromhere", contains numbers in column C and values in column B. It's basically the same ordinal numbers, but some are missing - that's why I started to write a macro in he first place.
I want Excel to check if the number in "tohere", Cell C1 exists in any cell in "fromhere", column C, and if it does, copy the value from the corresponding row in "fromhere", column B into "tohere", Cell B1; then do it again for C2 etc. If there's no such number in sheet "fromhere", just do nothing about this row.
I tried this code:
Dim i As Long
Dim tohere As Worksheet
Dim fromhere As Worksheet
Set tohere = ThisWorkbook.Worksheets("tohere")
Set fromhere = ThisWorkbook.Worksheets("fromhere")
For i = 1 To 100
If fromhere.Range("C" & i).Value <> tohere.Range("C" & i).Value Then
Else: fromhere.Cells(i, "B").Copy tohere.Cells(i, "B")
End If
Next i
It does what I want for the first cells that are equal (4 in my case) and then just stops without looking further.
I tried using Cells(i, "C") instead, same thing. Using i = i + 1 after Then doesn't help.
I feel that the problem is in my cells addressing, but I don't understand how to fix it.
This is how my sample "fromhere" list looks like (you can notice some numbers are missing from the C column):
This is the sample of what I get with the "tohere" list:
It gets to the point where there's no "5" in "fromhere" and stops at this point.
P.S.: i = 1 To 100 is just to test it.
This should do your job. Run this and let me know.
Sub test()
Dim tohere As Worksheet
Dim fromhere As Worksheet
Dim rngTohere As Range
Dim rngfromHere As Range
Dim rngCelTohere As Range
Dim rngCelfromhere As Range
'Set Workbook
Set tohere = ThisWorkbook.Worksheets("tohere")
Set fromhere = ThisWorkbook.Worksheets("fromhere")
'Set Column
Set rngTohere = tohere.Columns("C")
Set rngfromHere = fromhere.Columns("C")
'Loop through each cell in Column C
For Each rngCelTohere In rngTohere.Cells
If Trim(rngCelTohere) <> "" Then
For Each rngCelfromhere In rngfromHere.Cells
If UCase(Trim(rngCelTohere)) = UCase(Trim(rngCelfromhere)) Then
rngCelTohere.Offset(, -1) = rngCelfromhere.Offset(, -1)
Exit For
End If
Next rngCelfromhere
End If
Next rngCelTohere
Set tohere = Nothing
Set fromhere = Nothing
Set rngTohere = Nothing
Set rngfromHere = Nothing
Set rngCelTohere = Nothing
Set rngCelfromhere = Nothing
End Sub