I have values coming from a table that i am trying to write a VBA macro for to move to another sheet where it will be place in the next empty row,
here is what i have so far as far as selecting the data goes:
'storing the values to be moved
Dim DayID As String
Dim Shift As Integer
Dim Operator As String
Dim Operation As String
Dim PartNum As String
Dim Asset As String
'placing selected cells
Sheets("Raw Data").Select
Range("A10000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).select
ActiveCell.Value = DayID
I got to this point to see if what i had worked with just putting the date in ad it did not. I am new to VBA and don't fully understand what i am doing yet so any help is appreciated!
the columns I'm placing the data in are in columns A, M, O, Q, N, and P respectively if that helps
This assumes that you are working on the same workbook that contains the code. If not, you can change "ThisWorkbook" to "ActiveWorkbook". I included the With wsTarget even though it is currently excessive, with the belief that as you build this subroutine up, it will become increasingly relevant. Edited to place the first three variables into their appropriate columns. I leave it to you to fill in the remaining code:
Sub FirstStep()
'storing the values to be moved
Dim DayID As String
Dim Shift As Integer
Dim Operator As String
Dim Operation As String
Dim PartNum As String
Dim Asset As String
Dim wsTarget As Worksheet
Set wsTarget = ThisWorkbook.Worksheets("Raw Data") 'Would be much better to change the CodeName of the sheet and reference directly.
'placing selected cells
With wsTarget
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = DayID
.Cells(Rows.Count, 13).End(xlUp).Offset(1, 0).Value = Shift
.Cells(Rows.Count, 15).End(xlUp).Offset(1, 0).Value = Operator
End With
End Sub
Without fully knowing what values you want to fill in, what sheet you are starting with and how exactly you want the results to look, something like the following should at least get you started.
Sub test()
Dim rData As Worksheet
Dim lRow As Long
Dim arr(5) As Variant
Set rData = Sheets("Raw Data")
arr(0) = "A"
arr(1) = "M"
arr(2) = "O"
arr(3) = "Q"
arr(4) = "N"
arr(5) = "P"
With rData
For Each element In arr
lRow = .Cells(.Rows.Count, element).End(xlUp).Row + 1
.Cells(lRow, element).Value = "Value in Column " & element
Next element
End With
End Sub
Related
I don't have experience using arrays in VBA and I got lost. What I try to do is the following:
In the column A I have ~15 strings (number is not fixed sometimes it is more sometimes less)
I remove duplicates and then for each name in the column A I would like to create separate sheet in the file.
I created an array to which I tried to assign each name from A with this loop:
Sub assigningvalues()
Dim i As Integer
Dim myArray(20) As Variant
Dim finalrow As Long
ActiveSheet.Range("A1", Range("A1").End(xlDown)).RemoveDuplicates Columns:=Array(1)
finalrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlDown).Row
'For i = 2 To finalrow -> I get overflow error when I use this range
For i = 2 To Cells(20, 1)
myArray(i) = Cells(i, 1).Value
Next i
'I check with the lines below if values were assigned
Cells(2, 4).Value = myArray(4)
Cells(3, 4).Value = myArray(2)
End Sub
Nevertheless values from the cells to do not assign to the array
Moreover when I try to use finalrow as range for the loop I get overflow error (It is not a big problem as there are workarounds, although it would be nice to know what I've done wrong)
Try the code below:
Option Explicit
Sub assigningvalues()
Dim i As Long
Dim myArray(20) As Variant
Dim FinalRow As Long
Dim Sht As Worksheet
Set Sht = ThisWorkbook.Sheets("Sheet1") ' modify "Sheet1" to your sheet's name
With Sht
.Range("A1", .Range("A1").End(xlDown)).RemoveDuplicates Columns:=Array(1)
FinalRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' get last row in column "A"
For i = 2 To FinalRow
myArray(i) = Cells(i, 1).Value
Next i
'I check with the lines below if values were assigned
.Cells(2, 4).Value = myArray(4)
.Cells(3, 4).Value = myArray(2)
End With
End Sub
Note: you can read the contents of the Range to a 1-D Array without a For loop, using Application.Transpose, you need to change the line you define it to:
Dim myArray As Variant
and populate the entire array using:
myArray = Application.Transpose(.Range("A2:A" & FinalRow))
Try the code below:
Sub assigningvalues()
Dim myArray As Variant
ActiveSheet.Range("A1", Range("A1").End(xlDown)).RemoveDuplicates Columns:=Array(1)
myArray = ActiveSheet.Range("A1", Range("A1").End(xlDown))
For Each element In myArray
ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = element
Next element
End Sub
NOTES: The problem with your above code was, that
ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlDown).Row
returned the absolut number of rows in the sheet, not the used ones. Since your array has length 20 and the sheet about 1 Mio. rows, you have an overflow. you can check this by using
Debug.Print ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlDown).Row
In the above code, after you remove dublicates, you again go down from A1 to the end and save the range to an array. The array myArray now contains all the cell values in your reduced range.
Now you loop over the elements with
For Each element in myArray
and create a new sheet with Workbook.Sheets.Add and assign the name my setting Sheets(index).name = element
The above code should work for you. Few remarks:
Instead of using "ActiveSheet", ThisWorkbook, etc. You should always start a Sub with this:
Dim wb As Workbook
Set wb = ThisWorkbook 'for the workbook containing the code
Set wb = Workbooks(workbookName) 'to reference an other Workbook
'And for all the sheets you are using
Dim ws As Worksheet
Set ws = wb.Sheets(sheetName) 'this way you avoid problems with multiple
workbooks that are open and active or
unactive sheets.
I have a spreadsheet with values starting at A5 and running across to column AI, there could be any number of entries to the rows.
Row A contains an Item code (e.g. 000-0000)
I am looking to produce some code to complete the following two actions:
If column AI = yes, then copy entire row and paste below. With every copy add a sequential alphabetised letter to the code in column A (e.g. 000-0000a)
Any help would be greatly appreciated. Everything i've found expands to copying to another sheet and i'm struggling to break down the code.
Thanks
Edit:
Please see below current code I have been trying to get to work which works up to the point of copying the row however fails to paste it.
Sub NewItems(c As Range)
Dim objWorksheet As Worksheet
Dim rngNewItems As Range
Dim rngCell As Range
Dim strPasteToSheet As String
'Used for the new worksheet we are pasting into
Dim objNewSheet As Worksheet
Dim rngNextAvailbleRow As Range
'Define the worksheet with our data
Set objWorksheet = ThisWorkbook.Sheets("Sheet1")
'Dynamically define the range to the last cell.
'This doesn't include and error handling e.g. null cells
'If we are not starting in A1, then change as appropriate
Set rngNewItems = objWorksheet.Range("A5:A" & objWorksheet.Cells(Rows.Count, "A").End(xlUp).Row)
'Now loop through all the cells in the range
For Each rngCell In rngNewItems.Cells
objWorksheet.Select
If rngCell.Value <> "Yes" Then
'select the entire row
rngCell.EntireRow.Select
'copy the selection
Selection.Copy
'Now identify and select the new sheet to paste into
Set objNewSheet = ThisWorkbook.Sheets("Sheet1" & rngCell.Value)
objNewSheet.Select
'Looking at your initial question, I believe you are trying to find the next available row
Set rngNextAvailbleRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row)
Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select
ActiveSheet.Paste
End If
Next rngCell
objWorksheet.Select
objWorksheet.Cells(1, 1).Select
'Can do some basic error handing here
'kill all objects
If IsObject(objWorksheet) Then Set objWorksheet = Nothing
If IsObject(rngBurnDown) Then Set rngNewItems = Nothing
If IsObject(rngCell) Then Set rngCell = Nothing
If IsObject(objNewSheet) Then Set objNewSheet = Nothing
If IsObject(rngNextAvailbleRow) Then Set rngNextAvailbleRow = Nothing
End Sub
So there are lots of things to address with your code. Many of which I have touched on. But the main thing to observe is that you are testing Column A not Column AI for the presence of "Yes" - so there may not be a match hence no copy.
As the paste destination is determined by a concatenation to create a sheet name you should have a test to ensure that sheet exists.
For testing I simply ensured a sheet called Sheet1a existed, that Sheet1 cell A5 had "a" in it, and there was a "Yes" in column AI. This could be improved but is enough to get you going.
This line is looping column A:
Set rngNewItems = objWorksheet.Range("A5:A" & lastRow)
Whereas this line is testing column AI:
If rngCell.Offset(, 35).Value <> "Yes"
Note <> means Not Equal as opposed to =
So perhaps you wanted:
If rngCell.Offset(, 35).Value = "Yes"
Consider the following re-write.
Option Explicit
Public Sub NewItems() 'c As Range) 'I have commented out parameter which isn't currently used.
Dim rngBurnDown As Range ' not used but also not declared
Dim objWorksheet As Worksheet
Dim rngNewItems As Range
Dim rngCell As Range
Dim strPasteToSheet As String
Dim objNewSheet As Worksheet
Dim lastRowTargetSheet As Long
Set objWorksheet = ThisWorkbook.Sheets("Sheet1")
Dim lastRow As Long
lastRow = objWorksheet.Cells(Rows.Count, "A").End(xlUp).Row
Set rngNewItems = objWorksheet.Range("A5:A" & lastRow)
Dim copiedRange As Range 'for union
For Each rngCell In rngNewItems.Cells
'Debug.Print rngCell.Address 'shows where looping
If rngCell.Offset(, 35).Value = "Yes" Then
Set objNewSheet = ThisWorkbook.Sheets("Sheet1" & rngCell.Value)
Dim nextTargetCell As Range
lastRowTargetSheet = objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row
Set nextTargetCell = objNewSheet.Range("A" & lastRowTargetSheet)
rngCell.EntireRow.Copy nextTargetCell
Set objNewSheet = Nothing 'clear inside loop as you are setting in loop
lastRowTargetSheet = 0
Set nextTargetCell = Nothing
End If
Next rngCell
objWorksheet.Cells(1, 1).Select
End Sub
As for your lettering:
There are lots of examples online to generate these. Here is one way, by #harfang, from here:
Sub List_A_to_ZZZZ()
Dim i As Long
For i = 1 To 20 ' I have shortened this QHarr. Original end was 475254 ' ColXL("ZZZZ")
Debug.Print Right("---" & XLcL(i), 4)
Next i
End Sub
Function XLcL(ByVal N As Long) As String
Do While N > 0
XLcL = Chr(vbKeyA + (N - 1) Mod 26) & XLcL
N = (N - 1) \ 26
Loop
End Function
Function ColXL(ByVal abc As String) As Long
abc = Trim(Replace(UCase(abc), "-", ""))
Do While Len(abc)
ColXL = ColXL * 26 + (Asc(abc) - vbKeyA + 1)
abc = Mid(abc, 2)
Loop
End Function
I tried to copy data from one workbook to another workbook based on some criteria. The macro is written in the destination workbook as below.
However when I run the code, i get an "Runtime Error 9. Script out of range error". Can anyone help me take a look of the code? Thanks!!!!
Sub sbCopyRangeToAnotherSheetFromLastRow()
Dim s1Sheet As Worksheet, s2Sheet As Worksheet
Dim source As String
Dim target As String
Dim path As String
Dim path1 As String
Dim rngSource As Range
Dim rngTargetStart As Range
Dim rngTargetStart2 As Range
Dim j As Long, k As Long, erow As Integer
source = "PB Position" 'Source Tab Name
path_source = "C:\Temp\MIS RISK REPORT.xlsm"
target = "Input - Trailing 12 week" 'Target tab Name
Application.EnableCancelKey = xlDisabled
Set s1Sheet = Workbooks.Open(path_source).Sheets(source)
Set s2Sheet = ThisWorkbook.Sheets(target)
Set rngSource = Range(s1Sheet.Range("A8"), s1Sheet.Cells.SpecialCells(xlCellTypeLastCell))
Set rngTargetStart = s2Sheet.Range("C" & Rows.Count).End(xlUp).Offset(1)
k = rngSource.Rows.Count
For j = 8 To k
If (rngSource.Cells(j, "O") = "K1" Or rngSource.Cells(j, "O") = "K2" Or rngSource.Cells(j, "O") = "G2") And rngSource.Cells(j, "AH") <> 1 Then
rngSource.Cells(j, "A").EntireRow.Select
Selection.Copy
Worksheets(target).Select
erow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, "C").Select
ActiveSheet.Paste
ActiveWorkbook.Save
Application.CutCopyMode = False
End If
Next j
End Sub
I was about to write a third comment, so I'll lump all my advice into an answer and hopefully this clean-up will fix your problems.
1) Your Set rngSource row should read
s1Sheet.Range("A8", s1Sheet.Cells.SpecialCells(xlCellTypeLastCell))
That may not be the problem here but it actually targets the range you want I think!
2) You should also avoid using Select (see this previous SO question). Instead, first calculate erow, then use
rngSource.Cells(j, "A").EntireRow.copy destination:= ActiveSheet.Cells(erow,"C")
Except that you can't paste an entire row into a cell in column C! It should actually be
rngSource.Cells(j, "A").EntireRow.copy destination:= ActiveSheet.Cells(erow,"A")
THIS may be where your out of range error is coming from
I am trying to run a macro on 3 different ranges, one after another. Once the range is selected, the code works just fine (where variables F and L are defined). I would like to set r1-r3 as Ranges I need and then use a string variable to concatenate the range numbers together. This code works, but doesn't provide the starting and ending row number in the range selected. This is vital because it tells the "TableCalc" macro when to start and stop the code. I would then like to move on to the next range. Thanks for your help.
Sub TestRangeBC()
WS.Select
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim rngx As String
Dim num As Integer
Dim rng As Range
Set r1 = WS.Range("ONE")
Set r2 = WS.Range("TWO")
Set r3 = WS.Range("THREE")
For num = 1 To 3
rngx = "r" & num
Set rng = Range(rngx)
Dim F As Integer
Dim L As Integer
F = rng.Row + 1
L = rng.Row + rng.Rows.Count - 2
Cells(F, 8).Select
Do While Cells(F, 8) <> "" And ActiveCell.Row <= L
'INSERT SITUATIONAL MACRO
Call TableCalc
WS.Select
ActiveCell.Offset(1, 0).Select
Loop
Next num
End Sub
This is not the answer (as part of your code and what you are trying to achieve is unclear yet), but it is a "cleaner" and more efficient way to code what you have in your original post.
Option Explicit
Dim WS As Worksheet
Your original Sub shorten:
Sub TestRangeBC()
' chanhe WS to your Sheet name
Set WS = Sheets("Sheet1")
Call ActiveRange("ONE")
Call ActiveRange("TWO")
Call ActiveRange("THREE")
End Sub
This Sub gets the Name of the Named Range (you set in your workbook) as a String, and sets the Range accordingly.
Sub ActiveRange(RangeName As String)
Dim Rng As Range
Dim F As Integer
Dim L As Integer
Dim lRow As Long
With WS
Set Rng = .Range(RangeName)
' just for debug purpose >> to ensure the right Range was passed and set
Debug.Print Rng.Address
F = Rng.Row + 1
L = Rng.Row + Rng.Rows.Count - 2
lRow = F
' what you are trying to achieve in this loop is beyond me
Do While .Cells(F, 8) <> "" And .Cells(lRow, 8).Row <= L
Debug.Print .Cells(lRow, 8).Address
'INSERT SITUATIONAL MACRO
' Call TableCalc
' not sure you need to select WS sheet again
WS.Select
lRow = lRow + 1
Loop
End With
End Sub
What are you trying to test in the loop below, what are the criteria of staying in the loop ?
Do While Cells(F, 8) <> "" And ActiveCell.Row <= L
it's really hard to tell what you may want to do
but may be what follows can help you clarifying and (hopefully) doing it!
first off, you can't "combine" variable names
So I'd go with an array of named ranges names (i.e. String array) to be filled by means of a specific sub:
Function GetRanges() As String()
Dim ranges(1 To 3) As String
ranges(1) = "ONE"
ranges(2) = "TWO"
ranges(3) = "THREE"
GetRanges = ranges
End Function
so that you can clean up your "main" sub code and keep only more relevant code there:
Sub TestRangeBC()
Dim r As Variant
Dim ws As Worksheet
Set ws = Worksheets("Ranges") '<--| change "Ranges" to your actual worksheet name
For Each r In GetRanges() '<--| loop through all ranges names
DoIt ws, CStr(r) '<--| call the range name processing routine passing worksheet and its named range name
Next r
End Sub
the "main" sub loops through the named ranges array directly collected from GetRanges() and calls DoIt() to actually process the current one:
Sub DoIt(ws As Worksheet, rangeName As String)
Dim cell As Range
Dim iRow As Long
With ws.Range(rangeName) '<--| reference the passed name passed worksheet named range
For iRow = .Rows(2).Row To .Rows(.Rows.Count - 2).Row '<--| loop through its "inner" rows (i.e. off 1st and last rows)
Set cell = ws.Cells(iRow, 8) '<--| get current row corresponding cell in column "F"
If cell.value = "" Then Exit For '<--| exit at first blank column "F" corresponding cell
TableCalc cell '<-- call TableCalc passing the 'valid' cell as its parameter
Next iRow
End With
End Sub
If I have a column of values, how do I read the values into a variable in VBA, perform some operation on it and then write it to the next column? Seems mind numbingly simple but I haven't been able to find a simple guide.
for example:
Column A = 1, 4, 5, 7
without writing formulas into column B
Dim A, B
A = column a
B = log(A)
write the values of B to the next column.
Thanks!
If you want to loop through a whole sheet you can do it like this.
Dim lRow as long
Dim strA as string
Dim strB as string
Dim ws As Excel.Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1")
lRow = 1
Do While lRow <= ws.UsedRange.Rows.count
'Read the data from columnA
strA = ws.Range("A" & lRow).Value
'do something with the value you got from A
strB = strA & "some other text"
strB = log(strA)
'Write it to C
ws.Range("C" & lRow).Value = strB
lRow = lRow + 1
ws.Range("A" & lRow).Activate
Loop
Or if you just want a certain predefined row it would be more hard coded like this.
'Read the data from columnA
strA = ws.Range("A6").Value
'do something with the value you got from A
strB = strA & "some other text"
strB = log(strA)
'Write it to C
ws.Range("C6").Value = strB
Try this macro:
Sub test()
Dim cel As Range, rng As Range
Dim logCel As Double
Dim lastRow As Integer
lastRow = Cells(1048576, 1).End(xlUp).Row
Set rng = Range(Cells(1, 1), Cells(lastRow, 1)) 'Create a range to search
For Each cel In rng
If Not IsEmpty(cel) Then 'If the cell has a value in it
logCel = Log(cel) 'add the LOG of the value to a variable
cel.Offset(0, 1).Value = logCel 'In the cell to the right of the cell, put the log
End If
Next cel
End Sub
To learn about setting cell values and such, I highly recommend using the macro recorder, then looking through the macro when you're done. Start the recorder, then enter a value into a cell, then in the one next, enter a log of that one, and you'll get some idea of how VBA works.
Rather than looping through cell by cell you would write directly to the worksheet using a LOG formula (no need for an array as the manipulation can be used directly with inserting a formula):
Sub LikeThis()
Dim rng1 As Range
`work on A1:A20 and write to B1:B20
Set rng1 = [a1:a20]
rng1.Offset(0, 1).FormulaR1C1 = "=IF(RC[-1]>0,LOG(RC[-1]),""not valid"")"
End Sub