I'm currently using a loop with a variable that changes based on a a list. The loop creates new worksheets and names them based on the current value of the variable "c".
I would like to introduce another variable "b" and have it represent the same row as "c" is on but a different column. I also want to "b" to then write it's value to a specific cell on the new worksheet. I
I have not been able to figure out how to introduce a second variable and have it loop it's own list within the already running loop.
Here is the current code:
Sub CopyIndTemplate()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range
Set sh1 = Sheets("Individual Template")
Set sh2 = Sheets("List")
For Each c In sh2.Range("b1", sh2.Cells(Rows.Count, 2).End(xlUp))
sh1.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value: ActiveSheet.Range("A1") = c.Value: ActiveSheet.Range("b9") = b.Value
Next
End Sub
c represents the current cell in column B.
If you want to get the cell in the same row but in column C, you can do c.Offset(ColumnOffset:=1), and to get the cell in the same row but in column A, you can do c.Offset(ColumnOffset:=-1).
Range.Offset often makes for extremely confusing and hard-to-follow code when [mis]used with ActiveCell in loops, but when you want your code to convey that you mean to get a cell that's offset from the cell you're currently looking at, using it makes code that conveys intent, and that's the one single thing you want your code to do: do what it says, and say what it does.
Related
Sub Link()
Dim Turbidity As Long
Dim RawTurbidity As Range
'Sets variables Turbidity being the ActiveCell and RawTurbidity referring to the last captured cell in raw sheets'
Turbidity = ActiveCell.Row
Set RawTurbidity = Sheets("Raw Data").Range("C4").End(xlDown)
'The formula assigning the last captured cell in Raw sheets to the active cell '
Sheet1.Range(Sheet1.Cells(Turbidity, 4), Sheet1.Cells(Turbidity, 4)).Formula = RawTurbidity
End Sub
So this is the code I have and currently it does what it's suppose to do. We have two sheets atm sheet1 and Raw Data An instrument spits out data into column C of Raw data starting wtih C4 and going all the way down. The current code I wrote in essence paste the newest value the instrument spits out to the active cell in sheet1. I have a code on Raw Data that runs the macro only when a change is made to column C4 and lower. And it works exactly how I want it to however...
my question or issue is that when I add activecell.offset(1,0).select in order to have the activecell automatically go to the next row in sheet1 without me moving the mouse the macro copies and paste the same data into the next 4 cells. If I have the intrument spit out the data again than this time it occupies the next 6 rows with the same data.
Joe B, I think you are making this harder than it is.
Last value in a sheet column gets copied to the next open row in a specified column on another sheet? Is that right?
Option Explicit
Sub Link()
Dim ws1 As Worksheet
Dim wsRaw As Worksheet
Dim ws1LastRow As Long ' "Turbidity"
Dim wsRawLastRow As Long ' "RawTurbidity"
' I suggest you just name the sheets using the developer prop window
'It cuts this whole part out as you can call them directly
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set wsRaw = ThisWorkbook.Worksheets("Raw Data")
ws1LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row 'lets say you are pasting to column A
'ws1LastRow = ws1LastRow + 1
'There you go the next writable cell row, this is wasted code though, see below you just increment when you need it
wsRawLastRow = wsRaw.Cells(wsRaw.Rows.Count, "C").End(xlUp).Row 'This method doesn't care if your data starts in C4
'No formula needed, it is a straight "copy" here, actually faster as its an assignment
ws1.Cells(ws1LastRow + 1, "A").Value = wsRaw.Cells(wsRawLastRow, "C").Value
'the next open cell (defined by row) in your sheet 1 column is equal to the last row of your Raw Data sheet column
End Sub
Issue is that the data in sheet one is not inputted in order. A person may need the data calculated to row 10 and the next calculation needs to be in row 20 hence the need to copy the data into the active cell.
This was my bad for not stating that in the initial post as it's the primary reason for this strange formula.
I am going mad trying to do the simplest thing in VBA.
I want to automate the copying of Column C on a worksheet a variable number of times to the adjacent columns D, E, F...etc. of the same worksheet.
Stepping through the code, I have it copying the correct column ("C:C") but cannot get it to paste via Paste, Offset or Destination to column D etc. for the variable number of instances.
this is the code I'm using. Assume all the Dim and Set statements are done as it's a small part of larger Sub.
sht02AnalysisSummary.Activate
For i = 0 To AddCol
i = i + 1
lLastCol = sht02AnalysisSummary.Range("C3").End(xlToLeft).Column
rangeCopy.Copy
Column.Offset("0,lLastCol+i").Paste
Next i
sht01CoverPage.Activate
This sort of works now but with AddCol set at 3, the result is skipping Column D and only repeating the pasting once (into Column E) whereas it should be pasting into D,E & F. Any pointers will be much appreciated.
Do not manually code your iteration var in a For ... Next; you will be disrupting the built-in iteration and progression.
The xlToLeft leaves me confused about the destination (or is it source...?). Perhaps that should be xlToRight or your should start further right before starting to look to the left ?
you should be able to paste a single column into three consecutive destination columns at once.
AddCol = 3
with sht02AnalysisSummary
set rangeCopy = .range(.cells(3, "C"), .cells(.rows.count, "C").end(xlup))
rangeCopy.Copy destination:=.Cells(3, .columns.count).End(xlToLeft).resize(rangeCopy.rows.count, AddCol)
end with
This should work:
Sub CopyPaste()
Dim sht As Worksheet
Set sht = Worksheets("Sheet1")
With sht
.Columns(3).Copy .Columns(4)
End With
End Sub
I populated an excel sheet with the locations of blank cells in my sheet using suggestions from this post. So I have a Column A filled with locations in the following format
$X$1 or $X2:$X$4.
What I am trying to do is use those row numbers from the column explain above to populate a separate column. I want to use the row numbers as a reference in what to populate for the column. So a Column B looking something like
=$B$1 or =$B$2:$B$4 (took 1 and 2-4 and used it as row number for reference call)
Both columns are referencing a different sheet so please excuse any column naming.
I'm not sure if this is going to require VBA or if I can get away with just using a formula, I expect VBA due to desired specifics. I've looked at post like this and this. But neither of these fully encompass what I'm looking for. Especially since I want it to express all the contents in a $B$2:$B$4 case.
My intuition on how to solve this problem tells me, parse the string from Column A for the 1st number then check if it's the end of the string. If it is, feed it to the reference that populates Column B, if not then find the 2nd number and go through a loop that populates the cell (would prefer to keep all the content in one cell in this case) with each value for each reverence.
i.e.
=$B2
=$B3
=$B4
My question is how do I go about this? How do I parse the string? How do I generate the loop that will go through the necessary steps? Such as using the number as a reference to pull information from a different column and feed it neatly into yet another column.
If (for example) you have an address of $X2:$X$4 then
Dim rng As Range
Set rng = yourSheetReference.Range("$X2:$X$4")
If you want to map that to the same rows but column B then
Set rng = rng.Entirerow.Columns(2)
will do that. note: it's not so clear from your question whether you're mapping X>>B or B>>X.
Once you have the range you want you can loop over it:
For Each c in rng.Cells
'do something with cell "c"
next c
Something like this should work for you:
Sub Tester()
Dim shtSrc As Worksheet, c As Range, rng As Range, c2, v, sep
Set shtSrc = ThisWorkbook.Worksheets("Sheet1") '<< source data sheet
Set c = ActiveSheet.Range("A2") '<<range addresses start here
'process addresses until ColA is empty
Do While c.Value <> ""
'translate range to (eg) Column X
Set rng = shtSrc.Range(c.Value).EntireRow.Columns(24)
sep = ""
v = ""
'build the value from the range
For Each c2 In rng.Cells
v = v & sep & c2.Value
sep = vbLf
Next c2
c.Offset(0, 1) = v '<< populate in colB
Loop
End Sub
Try this code:
Sub Test()
Dim fRng As Range ' the cell that has the formula
Set fRng = Worksheets("sheet1").Range("A1")
Dim tWS As Worksheet 'the worksheet that has the values you want to get
Set tWS = Worksheets("sheet2")
Dim r As Range
For Each r In Range(fRng.Formula).Rows
'Debug.Print r.Row ' this is the rows numbers
Debug.Print tWS.Cells(r.Row, "N").Value 'N is the column name
Next
End Sub
Ok, the question sounds pretty vague, but i will try to explain.
I am trying to copy certain cell values from one sheet into another sheet. The place it should copy it to, is determined by another value in the same sheet. For example:
Sheet1
4040-5056 ----- 4040-5056v1.7
3409-5793 ----- 3409-5793v4.3
Sheet2
4040-5056
3409-5793
Based on the first values you see, the second column of values in sheet1 should be copied in the corresponding cells in sheet2.
I have no idea how to do this, any help would be appreciated!
Thanks in advance
EDIT:
Sheet1 contains all values that have to be copied to the corresponding nvalues in the other sheets.
The values it has to correspond with are spread over 30 sheets or so, but all in the same document. In every sheet the values the code has to look for are all in the same column, so in every sheet is should look whether the value is the same in column A. VLOOKUP works, but is still a slow option, knowing that is handles over 36.000 rows. What the code should do, is copy the value of column B to one of the other sheets, if the value of column A corresponds with the value of column A in the other sheet.
I hope everyone can understand this explanation.
You can use the VLOOKUP function. No need to use VBA for this.
Sheet 1 :
A B C
1 4040-5056 4040-5056v1.7
2 3409-5793 3409-5793V4.3
3
Sheet 2:
A B C
1 4040-5056 =VLOOKUP(A1;Sheet1!$A$1:$B$2;2;FALSE)
2 3409-5793 =VLOOKUP(A2;Sheet1!$A$1:$B$2;2;FALSE)
3
Cell B1 will display "4040-5056v1.7", cell B2 "3409-5793V4.3"
Note that the last argument to VLOOKUP (here FALSE) is important in your case since the data is unsorted.
Another solution, using pure VBA:
Since there is a strong need for performance, I suggest using a dict object, as hinted in this SO question. The advantage of using a dictionary is that it is very fast to lookup, once it is built. So I expect my code to be very quick in the lookup. On the other hand, it will be slower in accessing the individual cells (through loops) than the builtin VLOOKUP.
Comparative performance, using a reference sheet fof 30'000 entries, and 3 lookup sheets with 30'000 lines each:
VLOOKUP : 600 seconds
VBA / dictionary : 3 seconds
so the performance is 200x better with VBA dictionary in this context.
Note : you have to add a reference to "Microsoft Scripting Runtime" (from the tools->Reference menu of the VBA window)
Note : this solution will not work if the data in the reference sheet is not contiguous, or if there are duplicates.
Sub FillReferences()
Dim dict As New Scripting.Dictionary
Dim myRow As Range
Dim mySheet As Worksheet
Const RefSheetName As String = "sheet1"
' 1. Build a dictionnary
Set mySheet = Worksheets(RefSheetName)
For Each myRow In mySheet.Range(mySheet.Range("A1").End(xlDown), mySheet.Range("A" & mySheet.Rows.Count).End(xlUp))
' Append A : B to dictionnary
dict.Add myRow.Value, myRow.Offset(0, 1).Value
Next myRow
' 2. Use it over all sheets
For Each mySheet In Worksheets
If mySheet.Name <> RefSheetName Then
' Check all cells in col A
For Each myRow In mySheet.Range(mySheet.Range("A1").End(xlDown), mySheet.Range("A" & mySheet.Rows.Count).End(xlUp))
' Value exists in ref sheet ?
If dict.exists(myRow.Value) Then
' Put value in col B
myRow.Offset(0, 1).Value = dict(myRow.Value)
End If
Next myRow
End If
Next mySheet
End Sub
So, I've explored a few answered VBA Questions, but I'm still stuck. I have three sheets "By_Oppt_ID", "Top_Bottom" and "Non_Top_Bottom". The first two have a large amount of columns each with a unique name. Now there are some columns in By_Oppt_ID that aren't in "Top_Bottom". So I want to compare each column name in By_Oppt_ID to every column name in "Top_Bottom", and if the column name isn't found, copy that column name and all the rows beneath it, to a third worksheet "Non_Top_Bottom".
So Here's what I have:
Sub Copy_Rows_If()
Dim Range_1 As Worksheet, Range_2 As Worksheet
Dim c As Range
Set Range_1 = Workbooks("Complete_Last_Six_Months_Q_Results.xlsx").Sheets("Top_Bottom")
Set Range_2 = Workbooks("Complete_Last_Six_Months_Q_Results.xlsx").Sheets("By_Oppt_ID")
Application.ScreenUpdating = False ' Stays on the same screen even if referencing different worksheets
For Each c In Range_2.Range("A2:LX2")
' Checks for values not in Range_1
If Application.WorksheetFunction.CountIf(Range_1.Range("A1:CR1"), c.Value) = 0 Then
' If not, copies rows to new worksheet
' LR = .Cells(Row.Count, c).End(xUp).Row
c = ActiveCell
Sheets("By_Oppt_ID").Range("Activecell", "ActiveCell.End(xlDown)").Copy Destination:=Workbooks("Complete_Last_Six_Months_Q_Results.xlsx").Sheets("Non_Top_Bottom").Range("A1:A6745")
Set rgPaste = rgPaste.Offset(0, 1) 'Moves to the next col, but starts at the same row position
End If
Next c
End Sub
I've compiled this many ways and keep getting a series of errors: Subscript Out of Range/ Method "Global_Range" Failure. What am I doing wrong?
If you are going to have this code within the same workbook every time, try using
ThisWorkbook.Sheets("Top_Bottom")
instead of
Workbooks("Complete_Last_Six_Months_Q_Results.xlsx").Sheets("Top_Bottom")
replicate that through your code and see if that fixes the problem.
What do you mean by c = Activecell? Do you mean to say c.activate?
You might then also want to change the next line to
Sheets("By_Oppt_ID").Range(Activecell, ActiveCell.End(xlDown)).Copy Workbooks("Complete_Last_Six_Months_Q_Results.xlsx").Sheets("Non_Top_Bottom").Range("A1")