So I want a macro running in an Excel file ("input.xls") that is searching a column in another Excel file ("data.xls") for the value "1" (the only values in that columns are 1s and 0s). When it finds a "1," it should copy and paste the entire row from that file into "input.xls".
Here is the code that I have
Sub NonErrorDataParse()
Dim intEnd As Integer
Workbooks("data.xls").Sheets("Raw").Activate
intEnd = 65000
Range("F").Select
Do Until ActiveCell.Row = intEnd
If Int(ActiveCell.Value) = 1 Then
Range(ActiveCell.Row & ":" & ActiveCell.Row).Cut
intEnd = intEnd - 1
Workbooks("input.xls").Sheets("Non-errors").Activate
Range("A1").Select
ActiveSheet.Paste
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub
However, when I run it, it gives me a "subscript out of range" error on "data.xls." No matter how I fiddle with the code I can't seem to get past that error (even though I have OTHER macros that are accessing that sheet that work fine).
Any ideas as to how to fix it? Or better code that will do the same thing?
Thanks in advance
You don't have to Select or Activate each time you do a command.
You can also find the last used cell with Range("A65536").End(xlup) instead of parsing every cell (that probably caused your error).
The code would then look like:
Sub NonErrorDataParse()
Dim intEnd As Integer
Dim c As Range
intEnd = Workbooks("data.xls").Sheets("Raw").Range("A65536").End(xlUp).Row
For Each c In Workbooks("data.xls").Sheets("Raw").Range("F1:F" & intEnd)
If CStr(c.Value) = "1" Then
c.EntireRow.Cut
Workbooks("input.xls").Sheets("Non-errors").Rows("1:1").Insert Shift:=xlDown
End If
Next c
End Sub
Yet, if you have many rows, it would be faster to use the autofilter method or use a dictionary.
Related
Guy, I am beginner for VBA language, and I have a question to stuck on it.
How to make a macro script to check if ANY rows of column B is input word of "C" AND ANY rows of column C is empty, then it will trigger to highlight this row with color and prompt up the message box to remind user to correct it.
Also, the column D is using the formula and cell by cell method to check the above requirement.
=IF(ISBLANK(B4),"",IF(OR(B4="C",B4="O"),IF(AND(B4="C", ISBLANK(C4)),"WARNING: Case Closed! Please Write Down Resolution!",""),"ERROR: Invalid Value - Status! Please Input The Right Value!"))
For example, the row 4 meet up requirement and affected.
Is there way to do so?
Please help. Thanks.
UPDATE:Thanks Variatus!
When I save the file, it prompt up this message box. What can I do? Thanks.
Macro Screen
Error
Under normal circumstances you would be asked to show more of an own effort before receiving help on this forum, including from me. But apparently circumstances aren't normal. So, here we go. Paste this procedure to a standard code module (it's name would be a variation of Module1 by default).
Option Explicit
Sub MarkErrors()
' 283
Dim Spike() As String
Dim i As Long ' index of Spike
Dim Rl As Long ' last used row
Dim R As Long ' loop counter: rows
Application.ScreenUpdating = False
With Sheet1 ' this is the sheet's CodeName (change to suit)
.UsedRange.Interior.Pattern = xlNone ' remove all existing highlights
Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
ReDim Spike(1 To Rl)
For R = 2 To Rl
If Trim(.Cells(R, "B").Value) = "C" Then
If IsEmpty(.Cells(R, "C")) Then
.Range(.Cells(R, "A"), .Cells(R, "D")).Interior.Color = vbYellow
i = i + 1
Spike(i) = "Row " & R
End If
End If
Next R
End With
Application.ScreenUpdating = True
If i Then
ReDim Preserve Spike(1 To i)
MsgBox "Status errors were found in the following entries:-" & vbCr & _
Join(Spike, "," & vbCr), vbInformation, "Corrections required"
End If
End Sub
Pay attention to the specified worksheet Sheet1. This is a CodeName, and it is a default. Excel will create a sheet by that name when you create a workbook. The CodeName doesn't change when the user changes the tab name but you can change it in the VB Editor. It's the (Name) property of the worksheet.
Install the procedure below in the code sheet of Sheet1 (not a standard code module and therefore not the same as where you installed the above code. This module is created by Excel for each sheet in every workbook. Use the existing one.
Private Sub Worksheet_Activate()
' 283
MarkErrors
End Sub
This is an event procedure. It will run automatically whenever Sheet1 is activated (selected). So, under normal circumstances you shouldn't ever need to run the first procedure manually. But I've already talked about circumstances. They aren't always normal. :-)
Hoping someone can help – I expect there is something very simple that I am doing wrong.
The situation is this:
I have a table with variable rows (month to month)
Four columns where the one I am trying to place the formula in (CaseLink) is blank
Sample Table
The column ‘System’ has one of three values; CSv1, CSv2, PIA
The Case # column will have numbers – no repetition or consistency
The CaseLink column is where I am having the issue – I am trying to insert one of three hyperlinks to include the value in the Case # column. The link target is based on the value in the System column
Previously I only had two variables in the System column and was able to solve for with a simple IF statement as it was either true or false. Now with a third variable, I am having difficulties with the If / ElseIF format. Here is what I have tried:
Original if statement that works:
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-2]=""CSv1"",HYPERLINK(CONCATENATE(""https://open. cloudav.com/servicedeliverdo.aspx?rdx=9992956J43211&conv="",RC[-1]),RC[-1]),HYPERLINK(CONCATENATE(""https://open.topcloudav.com/ha2servicedeliverdo.aspx?conv="",RC[-1]),RC[-1]))"
Range("D3").Select
Option 1: (this returns an error: Sub or Function not defined on Concatenate)
Range("C2").Select
If ActiveCell.Offset(0, -2).Value = "CSv1" Then Hyperlink (CONCATENATE("https://open.cloudav.com/servicedo.aspx?rdx=9992956J43211&conv="),RC[-1]),RC[-1]))
ElseIf ActiveCell.Offset(0, -2).Value = "CSv2" Then Hyperlink (CONCATENATE("https://open.cloudav.com/topservicedo.aspx?conv="),RC[-1]),RC[-1]))
ElseIf ActiveCell.Offset(0, -2).Value = "PIA" Then Hyperlink (CONCATENATE("https://dev.devroot.net/browse/PIA-"),RC[-1]),RC[-1]))
End If
Range("D3").Select
Option 2: (this returns an error indicating ElseIF is undefined
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"IF(RC([-2])) = ""CSv1"" Then Hyperlink (CONCATENATE(""https://open.cloudav.com/servicedo.aspx?rdx=9992956J43211&conv="", RC[-1]), RC[-1])))"
elseif_
ActiveCell.FormulaR1C1 = _
"IF(RC([-2]) = ""CSv2"" then Hyperlink (CONCATENATE(""https://open.cloudav.com/topservicedo.aspx?conv="", RC[-1]), RC[-1])))"
elseif_
ActiveCell.FormulaR1C1 = _
"IF(RC([-2]))= ""PIA"" Then"
Hyperlink (concatenate("https://dev.devroot.net/browse/PIA-", (RC([-1])), (RC([-1]))))
End If
Range("D3").Select
I have also tried ActiveCell.Offset rather than ActiveCell.Formula with similar failure results
Any thoughts?
There a lot of thing that could be improve in your code:
Use variable instead of hard code
do not select
Indent better
I tried to replicate what you were doing,
Sub hyperlink()
Dim firstcellrow As Long ' First row where your code acts
Dim systemcellcollumn As Long ' Column w the system entries
Dim linkcollumn As Long ' Column where you want to link stuff
firstcellrow = 1 ' In my case
systemcellcollumn = 2 'From your image
linkcollumn = 4 'From your image
Dim activecellrow As Long ' Its a long name but thats actualy just a counter
Dim system As String ' Not needed if u use cell.text directly into select case
Dim i As Long
For i = 0 To 2 ' 0 to whatever you want
activecellrow = firstcellrow + i
system = Worksheets("test").Cells(activecellrow, systemcellcollumn).Text ' Not necessary, see comment under "Select Case"
Select Case system
' or Select Case Worksheets("test").Cells(activecellrow, systemcellcollumn).Text
Case "CSv1"
Cells(activecellrow, linkcollumn).FormulaR1C1 = "=IF(RC[-2]=""CSv1"",HYPERLINK(CONCATENATE(""https://open. cloudav.com/servicedeliverdo.aspx?rdx=9992956J43211&conv="",RC[-1]),RC[-1]),HYPERLINK(CONCATENATE(""https://open.topcloudav.com/ha2servicedeliverdo.aspx?conv="",RC[-1]),RC[-1]))"
Case "CSv2"
'etc
Case "PIA"
'etc
End Select
Next
End Sub
This code may not be perfect but is already more general and works
I appreciate all the comments - I am not a professional coder - This is something I am trying to get done by learning from everyone else. If this is not a forum where someone can go to ask for help without getting blasted for style, I apologize for wasting your time.
I did figure out a simple method of getting this done on my own in a single nested IF statement:
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-2]=""CSv1"",HYPERLINK(CONCATENATE(""https://open.cloudav.com/deliverdo.aspx?rdx=9992956J43211&conv="",RC[-1]),RC[-1]),IF(RC[-2]=""CSv2"",HYPERLINK(CONCATENATE(""https://open.cloudav.com/topdeliverdo.aspx?conv="",RC[-1]),RC[-1]),IF(RC[-2]=""PIA"",HYPERLINK(CONCATENATE(""https://dev.devroot.net/browse/PIA-"",RC[-1]),RC[-1]))))"
Range("A2").Select
I am trying to select a cell by giving which row and column to use.
It is giving me an error:
"Unable to get the select property of the range class."
when I get to this line:
Sheets("Ticker").Cells(currRow, etfCol).Select.Paste
Here is a short snippet of my really long code:
Dim etfCol As Integer, etfCount As Integer, currRow As Integer, currRowValue As String
etfCol = 1 'Just select the first column
etfCount = Sheets("Automated Table").Cells(Rows.Count, etfCol).End(xlUp).Row
'Repeat for every row.
For currRow = 5 To etfCount
''''''''''''''''''''''''''''''''''Copy and paste the ticker
Cells(currRow, etfCol).Copy
Sheets("Ticker").Cells(currRow, etfCol).Select.Paste
Next
Am I getting this error because "etfCount" is the value I got from "Automated Table" sheet, and I am trying to use that for "Ticker" sheet?
This is the only reason I could think of, but that doesn't wholly explain this error.
I tried debugging the code.
Replace:
Sheets("Ticker").Cells(currRow, etfCol).Select.Paste
with:
Sheets("Ticker").Cells(currRow, etfCol).Paste
This assumes that Sheets("Automated Table") is active.
If you are using .Select (which is not a good practice in VBA), you may profit a lot by the Macro Recorder. Just record the copy and the paste and examine the code:
Sub Makro4()
Range("B4").Select
Selection.Copy
Range("G8").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
As you see, the .Select and the .Paste are on various lines and so they should stay. In your code it should be:
Sheets("Ticker").Cells(currRow, etfCol).Paste
Sheets("Ticker").Cells(currRow, etfCol).Paste
Or you may do it a bit better:
With Sheets("Ticker").Cells(currRow, etfCol)
.Select
.Paste
End With
Anyway, as pointed out in the link, the usage of Select is not to be encouraged. (Although it works).
I'm trying to build a formula:
=BDS(Bonds!J2& " ISIN","ISSUE_UNDERWRITER","Headers","Y")
In one sheet that takes a unique identifier from another table.
These formula builds me a table. After it builds me the table, I need to take the next row in the other sheet:
=BDS(Bonds!J3& " ISIN","ISSUE_UNDERWRITER","Headers","Y")
Then insert that formula a the end of the previous table built by the previous formula.
What I tried was getting the last row and then offsetting it by one, but I'm trying to figure out how to loop through it.
This is what i have tried:
Sub Formula2()Formula2 Macro
Range("A1").Select
ActiveCell.FormulaR1C1 = _
"=BDS(Bonds!R[1]C[9]& "" ISIN"",""ISSUE_UNDERWRITER"",""Headers"",""Y"")"
lRow = Cells(Rows.Count, 1).End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = _
"=BDS(Bonds!R[-53]C10& "" ISIN"",""ISSUE_UNDERWRITER"",""Headers"",""Y"")"
Range("A57").Select
End Sub
Image of Table, Im trying to iterate through the ISIN Column. It is column "J"
Although selection and .select are used by the macro recorder, they cause big problems when developing code. It's worth your time to learn how to replace them with range objects. So, while I'm not directly answering your question, I'm trying to give you the tools to do so.
I've shown an example below to illustrate (although I do not work with the BDS() function so I'm undoubtedly getting the details wrong). The main point is that if you learn to move around using the range object you'll be much better off.
Sub formula()
Dim r As Range, sh As Worksheet, bondR As Range, bondSh as Worksheet
set sh = ActiveSheet
set r = sh.range("A1")
Set bondSh = Worksheets("Bonds")
Set bondR = bondSh.Range("J1")
For i = 1 To 10
r.formula = "=BDS(bondR.offset(i,0) & "" ISIN"",""ISSUE_UNDERWRITER"",""Headers"",""Y"")"
Set r = r.Offset(i, 0)
Next i
End Sub
Here I'm defining one range object, r, to track the location on the active sheet, and another, bondR, for the location on the "Bonds" sheet. Once the initial locations of these ranges are defined, you can manipulate them using the .offset(row,col) function as I've done with the simple for-loop, moving down 1 row (but 0 columns) in each loop.
Feel free to ask questions.
I've already did a lot of research and couldn't find a solution. I'm trying to find the second empty cell/row (or other specified cell) in a column and start pasting from it (always jumping to next empty cell/row).
I found the code below, but it starts pasting from the first empty row in a column. Changing the offset command to (2,0) doesn't work too because it finds the second empty row but starts pasting always leaving a empty cell between the collages. And I want to find the second empty cell only in the beginning and from there start pasting always in the next first empty cell/row. Can you guys help me please? Thanks a lot in advance!
For example, I'm copying the range G4:I4 and trying to paste into column G.
Code:
Sub InsertButton()
Range("G4:I4").Copy Range("G" & Rows.Count).End(xlUp).Offset(1, 0)
End Sub
Well, you're trying to write one function that does two different things. If you could include the loop that calls the function, that would be helpful. You could use two functions like this that do each of the things, or pass a parameter to the function that would tell it which thing to do.
Sub InsertButton1()
Range("G4:I4").Copy Range("G" & Rows.Count).End(xlUp).Offset(1, 0)
End Sub
Sub InsertButton2()
Range("G4:I4").Copy Range("G" & Rows.Count).End(xlUp).Offset(2, 0)
End Sub
or
Sub InsertButton(moveDownThisManyRows)
Range("G4:I4").Copy Range("G" & Rows.Count).End(xlUp).Offset(moveDownThisManyRows, 0)
End Sub
Then when you call it say
Sub doStuff()
Dim thisIsTheFirstTime As Boolean
thisIsTheFirstTime = True
For Each item In myStuff
If thisIsTheFirstTime Then
InsertButton2() 'or InsertButton(2)
thisIsTheFirstTime = False
Else
InsertButton1() 'or InsertButton(1)
End If
Next item
End Sub