I have some code here that works, but I'm having some troubles getting it to work multiple times in a row. What it does is it fills the first empty column with a formula from a different sheet.
Dim source As Worksheet
Dim destination As Worksheet
Dim EmptyColumn As Long
Dim LastRow As Long
Set source = Sheets("vlookup")
Set destination = Sheets("COMMIT")
LastColumn = destination.Cells(1,destination.Columns.Count).End(xlToLeft).Column
LastRow = Worksheets("COMMIT").Range("A:A").Rows.Count
If IsEmpty(destination.Range("A2")) = False Then
EmptyColumn = LastColumn + 1
destination.Cells(3, EmptyColumn).Formula = "=INDEX(PORT!$S$5:$S$4000,MATCH(COMMIT!$G3,PORT!$G$5:$G$4000,0))"
LastRow = ActiveSheet.UsedRange.Rows.Count
Range("AL3").AutoFill destination:=Range("AL3:AL" & LastRow) **'This is where I'm having issues'**
End If
I would like it to keep putting the index formula into the next empty column, but I only know how to put it into a range that I have set and will not move to the next column when I run this macro again.
Any thoughts on how I could achieve this?
Thanks to Scott for helping me out with this!
Now I have another question that has popped up in my code.
Set cellSource = Worksheets("COMMIT").Range(Cells(1, LastColumn).Address)
Set cellTarget = Worksheets("COMMIT").Range(Cells(1, LastColumn), Cells(1, EmptyColumn))
If detntn.Range("A2") <> "" Then
cellSource.AutoFill destination:=cellTarget, Type:=xlFillDefault
End If
Now I'm trying to copy a formula from the "Commit" worksheet and paste it in the first cell of the first empty column. For some reason this code is not working. Wondering if anyone can sniff out as to why. Thanks in advance for your help!
Part of the problem is you have used a reserved word for a variable. Look at the AutoFill function, It uses Destination.
Then we can use the Cells() instead of Range to refer to the last column.
Dim source As Worksheet
Dim detntn As Worksheet
Dim EmptyColumn As Long
Dim LastRow As Long
Set source = Sheets("vlookup")
Set detntn = Sheets("COMMIT")
LastColumn = detntn.Cells(1, detntn.Columns.Count).End(xlToLeft).Column
LastRow = Worksheets("COMMIT").Range("A:A").Rows.Count
If detntn.Range("A2")<>"" Then
EmptyColumn = LastColumn + 1
detntn.Cells(3, EmptyColumn).Formula = "=INDEX(PORT!$S$5:$S$4000,MATCH(COMMIT!$G3,PORT!$G$5:$G$4000,0))"
LastRow = ActiveSheet.UsedRange.Rows.Count
detntn.Cells(3, EmptyColumn).AutoFill destination:=detntn.Range(detntn.Cells(3, EmptyColumn), detntn.Cells(LastRow, EmptyColumn))
End If
Related
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
Below you will see two screenshots. The first one has a matrix with datas highlighted in the middle. I was able to get a VBA macro from people here in SO to copy those highlighted values and paste it in a new sheet in vertical order (The highlighted values are highlighted using conditional formatting in this case it's showing values < or = 50). That's the second screenshot showing the highlighted values pasted in vertical order. Now my issue is that I need to find the corresponding SAP# to those highlighted values (Screenshot 1) and then paste it in vertical order next to the Distance column (screenshot 2). Notice there is a SAP# column and an SAP# row. I'll need both these SAP #'s corresponding to the highlighted value. I have tried using INDEX-MATCH but I got wrong answers and I'm not an expert in For Next coding so I couldn't even write any code.
Would love some help in this issue. FYI this is just a small sample from my large data set. I have hundreds of columns and rows. And Here's the code that I used for copying the data:
Sub CopyConditionalData()
Application.ScreenUpdating = False
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("Location Analysis") ' change as needed
Set ws2 = Worksheets("Output") ' change as needed
Dim rRng As Range
Set rRng = ws1.Range("E5:ZZ200") 'change as needed
Dim aRng As Variant
aRng = rRng
Dim lRows As Long, lCols As Long
For lCols = 1 To rRng.Columns.Count
For lRows = LBound(aRng) To UBound(aRng)
If aRng(lRows, lCols) <= ws1.Range("D1") Then
ws2.Range("A" & ws2.Rows.Count).End(xlUp).Offset(1) = aRng(lRows, lCols)
End If
Next
Next
ws2.Select
End Sub
One issue I see which complicates this is the additional data you want to bring over is outside of your array: it will be easier to pick up the data starting at A1 and then adjust the starting point on your For loops.
Also there are no column/row headers visible on your screenshot which makes it a bit trickier for me to map out positions.
Untested - adjust to suit:
Sub CopyConditionalData()
Application.ScreenUpdating = False
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("Location Analysis") ' change as needed
Set ws2 = Worksheets("Output") ' change as needed
Dim rRng As Range
Set rRng = ws1.Range("A1:ZZ200") '<< ##note now starting from A1##
Dim aRng As Variant
aRng = rRng.Value
Dim lRows As Long, lCols As Long
'##adjust the loop start points to mimic E5##
For lCols = 5 To UBound(aRng, 2)
For lRows = 5 To UBound(aRng, 1)
If aRng(lRows, lCols) <= ws1.Range("D1") Then
With ws2.Range("A" & ws2.Rows.Count).End(xlUp).Offset(1, 0)
.Value = aRng(lRows, lCols)
.Offset(0, 1).Value = aRng(lRows, 2) 'from ColB
.Offset(0, 2).Value = aRng(1, lCols) 'row1 ?
End With
End If
Next
Next
ws2.Select
End Sub
I have been using StackOverflow for a while now and just love this community. I know I can get an answer for any problem hopefully.
Ok so here is my issue, I have been performing a "Frankenstein" of a script from several posts on this site. I want to copy and paste a column of an Array Formula beneath specific headers until there are no more headers. For example, in the row F5 through W5, if there is a name, I want to copy the range that has an array formula beneath it, say in the range F156:F323, and paste that formula in the name under the G Column, H Column, so on until there are no more names between that range...
Below is my attempt to solve it but I keep getting errors
Dim lastCol As Long
Dim i As Long
Dim ws As Worksheet
Dim Formula As Range
Set ws = Sheets("Main")
lastCol = ws.Range("F" & Columns.Count).End(xlRight).Column
Set Formula = Sheets("Main").Range("F156:F323")
With ws
For i = 6 To lastCol
If len(trim.range("F" & i).Value)) <> 0 then _
.Range(i & 156).formulaarray = 'my formula here'
Next i
End With
Post any questions you may have and thanks!
You are flipping columns and rows in many instances.
Use the Range Object Cells instead of Range. It allows using column references in numbers instead of letters.
Assign the formula directly.
Dim lastCol As Long
Dim i As Long
Dim ws As Worksheet
Dim Frmla As Range
Set ws = Sheets("Main")
lastCol = ws.Cells(5, ws.Columns.Count).End(xlToLeft).Column
Set Frmla = ws.Range("F156:F323")
With ws
For i = 6 To lastCol
If Len(Trim(.Cells(5, i).Value)) <> 0 Then
.Range(.Cells(156, i), .Cells(323, i)).FormulaR1C1 = Frmla.FormulaR1C1
End If
Next i
End With
I have cell addresses given in an excel sheet and wanted to print a specific formula in other excel sheet referring to the cell addresses given in the previous sheet. Please suggest vba function for this. The cell addresses are in string format so corresponding row no. and col. no need to be extracted from the string. Is there an existing function for this in vba?
I'm not sure I understand correctly, but the Range method accepts string input. For your example, this would work:
Worksheets("Sheet2").Range(Worksheets("Sheet1").Range("A1").Value)=Worksheets("Sheet1").Range("A2").Value
Same code, a bit easier on the eyes:
Dim strLocation As String
strLocation = Worksheets("Sheet1").Range("A1").Value
Worksheets("Sheet2").Range(strLocation) = Worksheets("Sheet1").Range("A2").Value
Is this what you are looking to do? Do you need more help understanding it?
Below code will check for last row in sheet1 column A and try to get values present in odd rows in column A and print the result in even row numbers
Sub testt1()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
Dim lastRow As Long
lastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
For i = 1 To lastRow
t1 = ws1.Cells(i, 1).Value
t2 = ws2.Range(t1).Value
ws1.Cells(i + 1, 1).Value = t2
i = i + 1
Next
End Sub
This is my first post. I've been trying to teach myself excel VBA and it has been quite challenging.
Anyways I have been working on loops and ranges etc etc.
Here's my dilemma:
Option Explicit
Sub Move_Data()
Dim i As Long
Dim j As Long
Dim LastRow As Long
Dim LastColumn As Long
Dim rng As Range
Dim result As String
result = "New Results"
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
LastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 3 To LastRow
For j = 1 To LastColumn
If Cells(i, 1) = result Then
j = j + 1
Cells(i, 1).Copy Destination:=ActiveSheet.Cells(i, j)
End If
Next j
Next i
End Sub
Little by little I have put the above together. Here's my question:
I am trying to look at all the values in column "A". Once "New Results" is found I want to copy not only this cell, but everything underneath it, to a column "J". Then find the string in column "B" and copy the range to column "K", etc.
So far the code finds "New Results" and moves it to column "B" which is expected since is the only code I have written. How can add another loop that will copy everything under "New Results" along with it and move it over to the new column. This way J will keep increasing and eventually I will have all the results broken down by columns.
Hopefully this makes sense.
Thanks all,
You dont have to loop through all the cells. Rather use the Find() method. It's more efficient I think.
Sub Move_Data()
Dim rngFound As Range
Dim intColLoop As Integer
Dim LastColumn As Integer
Dim result As String 'added in edit, forgot that, oops
Dim intColPaste As Integer 'added in edit
result = "New Results"
LastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
With Cells
'in case the result is not on the ActiveSheet, exit code
If .Find(result) Is Nothing Then Exit Sub
'*****************Search all the columns, find result, copy ranges
'search all the columns
For intColLoop = 1 To LastColumn
With Columns(intColLoop)
'check if the result is in this column
If Not .Find(result) Is Nothing Then
'find the result
Set rngFound = .Find(result)
'copy the found cell and continuous range beneath it to the destination column
Range(rngFound, rngFound.End(xlDown)).Copy Destination:=Cells(Rows.Count, 10 + intColPaste).End(xlUp) 'Edit : changed the "10" to "10 + intColPaste"
intColPaste = intColPaste + 1 'Edit : added counter for columns
End If
End With
Next intColLoop 'proceed to next column
End With
End Sub
Very well written for your first post, congrats!
Option Explicit
Sub Move_Data()
Dim SourceCol As integer
Dim DestCol As Integer
Dim LastRow As Long
'Dim LastColumn As Long
Dim rng As Range
Dim result As String
Dim Addr as string
SourceCol = 1 'Column A
DestCol = 2 'Column B
result = "New Results"
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
set rng = ActiveSheet.Range(cells.Address).Find (What:=Result, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)
While not rng is Nothing and Addr <> rng.Range.Address
'If not rng is Nothing
ActiveSheet.range(cells(rng.row, DestCol),cells(LastRow,DestCol) = _
ActiveSheet.range(cells(rng.row,SourceCol), cells(LastRow,SourceCol))
'End If
Addr = rng.range.address(ReferenceStyle:=xlR1C1)
set rng = ActiveSheet.Range(cells.Address).Find (What:=Result, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)
wend
End Sub
Adjust SourceCol and DestCol as needed.
That's untested and off the top of my head, so it might need a minor tweak. Use .Find() to find your text, then set your destination range = to what you just found.
As written, it will find one occurrence of result. If you have multiple occurrences of result, comment out/delete the If... and 'End If` lines, then uncomment the 4 lines that are commented & they'll loop through, finding them all.