What I am trying to do:
I am trying to copy only certain columns from a spreadsheet based on the header. Rather than do loops to copy each column individually, I am trying to copy a number of columns at once.
What I have so far:
With wb.Worksheets("Sheet1")
Set lasthead1 = .Range("1:1").Find(What:="*", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
Set headrng1 = .Range("A1", lasthead1)
For Each c In headrng1
If Left(c, 1) = "-" Then c = Mid(c, 2, Len(c) - 1)
If Left(c, 1) = "+" Then c = Mid(c, 2, Len(c) - 1)
Next c
Set PRIhead = headrng1.Find(What:="Priority", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
Set LOGhead = headrng1.Find(What:="Log Date", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
Set TYPEhead = headrng1.Find(What:="Type", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
Set CALLhead = headrng1.Find(What:="Call Status", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
Set DEShead = headrng1.Find(What:="Description", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
Set IPKhead = headrng1.Find(What:="IPK Status", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
.Range(PRIhead, LOGhead, TYPEhead, CALLhead, DEShead, IPKhead).EntireColumn.Copy
End With
The issue:
Appears to be with the following line of code:
.Range(PRIhead, LOGhead, TYPEhead, CALLhead, DEShead, IPKhead).EntireColumn.Copy
My Sources:
I used the accepted answer on This Question to put my line of code together.
Follow up from comments.
The reason of the issue is because Range(cell1,[cell2]) object can accept only 2 cells as parameters.
So you need to use
wb.Application.Union(PRIhead, LOGhead, TYPEhead, CALLhead, DEShead, IPKhead).EntireColumn.Copy
I used wb.Application.Union because (as follow up from comments), workbook wb is a part of another application object.
Related
I'm new to VBA. I want to find the headers of six columns and join them using the union method. Once they are joined as BigColumns, I want to change the font size to 14.
I've already tried looping, but given that I am new to this I wanted to try a simpler way. I can successfully run this code on one range, such as TC1, and change the font to 14. But as soon as I try combining ranges, it fails.
Sub ASOLDPrintFormatTesting2()
Dim Table As Range
Dim BigColumns As Range
Dim TC1, TC2, TC3, TC4, TC5, TC6 As Range
'TC stands for Table Columns These individual ranges are joined through
Union Method
Set ReferenceCell = ActiveCell
Set WS = Sheets(2)
With WS
Set ReferenceCell = Cells.Find(What:="Source #", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'Make Source # the Reference Cell, or the equivalent of A1
If Not ReferenceCell Is Nothing Then
Set ReferenceCell = Cells.Find(What:="Sample #", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
End If
'Make Sample # the Reference Cell
Set Table = ReferenceCell.CurrentRegion
With Table
Set TC1 = .Find(What:="Source Well", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set TC2 = .Find(What:="Sample ID", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set TC3 = .Find(What:="VerboseConc_uM", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set TC4 = .Find(What:="VerboseConc_ug/ml", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set TC5 = .Find(What:="Mol Wt.", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set TC6 = .Find(What:="N/Mole", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'Find all headers of BigColumns
Set BigColumns = Application.Union(Range("TC1"), Range("TC2"), _
Range("TC3"), Range("TC4"), Range("TC5"), Range("TC6"))
'Union of all headerrs as BigColumns
If Not BigColumns Is Nothing Then
Else
MsgBox "'BigColumns' not found"
Exit Sub
End If
End With
With BigColumns
.Cells.Font.Size = 14
End With
'Test to see if BigColumns works
End With
End Sub
No error messages are produced when the code runs.
Using an array (will give a snippit example), you should be able to loop and save some time and possible issues where things are not found:
dim arr as variant, i as long
arr = array("Source Well","Sample ID") 'can add more
with table
for i = lbound(arr) to ubound(arr)
set f = .find(what:=arr(i))
if not f is nothing then f.font.size = 14
next i
end with
-untested code-
You find your item, if it's not found it skips changing the font size.
I am trying to make a userform that can bring up data using an ID number.
I am trying to reference a text box and select it, and then using it as a reference to fill out the Time and comments in the sheet. I think the is I cant put "txtID.Value" into the Find function.
Here is an example of my code:
Sheet1.Select
Columns("A:A").Select
Selection.Find(What:="txtID.Value", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Select
ActiveCell.Offset(0, 8).Value = txtTime2
ActiveCell.Offset(0, 9).Value = txtComment2
When using the Find function, it's recommended to use a Range object, and set it to the result. This method allows you to trap a possible scenario where Find failed to find a match in the searched range Sheet1.Columns("A:A").
Also, try to avoid using Select, Selection and ActiveCell, and use fully qualified Range objects (like in the code below).
Code
Dim FndRng As Range
Set FndRng = Sheet1.Columns("A:A").Find(What:=txtID.Value, LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not FndRng Is Nothing Then ' successful find
FndRng.Offset(, 8).Value = txtTime2
FndRng.Offset(, 9).Value = txtComment2
Else ' unable to fins the value in txtID
MsgBox "Unable to find " & txtID.Value & " in Sheet1"
End If
Note: if you have this code outisde the User_Form module, then you need to add the User_Form reference when trying to get the txtID.Value.
For eaxmple, let's say the name of your form is UserForm1, then change this line to:
Set FndRng = Sheet1.Columns("A:A").Find(What:=UserForm1.txtID.Value, LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
To Make it work, you will have to put the code as below, which is quite self explainatory.
Selection.Find(What:=Userform1.textbox1.value, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Select
hope this helps
I want to create a range from a cell containing, for example, the word "alex" to lastrow, in the first column.
Let's call this cell-alex.
The idea is to make:
range(cell-alex, cells(lastrow, 1)).
I know how to get lastrow, but not cell-alex. Excel always selects the range from A1 to the lastrow.
Cells.Find(What:="alex", after:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True _
, SearchFormat:=True).Select
Set sht = Worksheets(sheetbr)
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Range(ActiveCell, Cells(lastrow, 13)).Select
if you know for sure that "Alex" is in column 1, then use this:
With Worksheets(sheetbr)
.Range(.Columns(1).Find(What:="alex", after:=.Cells(.Rows.Count, 1), LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, _
SearchFormat:=True), _
.Cells(.Rows.Count, "A").End(xlUp)).Select
End With
otherwise use this:
Dim f As Range
With Worksheets(sheetbr)
Set f = .Columns(1).Find(What:="alex", after:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True _
, SearchFormat:=True)
If Not f Is Nothing Then .Range(f, .Cells(.Rows.Count, "A").End(xlUp)).Select
End With
I think the problem is LookIn:=xlFormulas. Try changing to LookIn:=xlValues
All right, I have figured out this.
I did not tell you everything.
I start my code with importing another document.
While I was working on my code, the moment you mention ActiveCell it starts working with the other book.
I resolved it by copying data from my imported spreadsheet to the original (book1).
The rest was easy. Here it goes:
Set sht = ThisWorkbook.Worksheets(1)
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row 'to find the lastRow
Cells.Find(What:="GuV 7", after:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate
Range(ActiveCell, Cells(lastrow, 13)).Select 'I need columns 1-13
Once again, thanks guys.
I have the code below (loop) to search for 0's in my spreadsheet (Column D) when it finds one if performs a copy/paste and then deletes the row. After all the filtered 0's (the column is filtered by column A - duplicates) I tell it to end sub. But I found the find is finding the 0's in the filtered hidden rows so the loop keeps going.
How can make the find only work on the visible rows and then end when all the 0's have been dealt with.
Set RangeObj = Cells.Find(What:="0", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If RangeObj Is Nothing Then RangeObj.Activate
Cells.Find(What:="0", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
What you need is the SpecialCells(xlCellTypeVisible) method and the .FindNext method.
See the below code:
Set RangeObj = Cells.SpecialCells(xlCellTypeVisible).Find(What:="0", After:=Range("A1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not RangeObj Is Nothing Then
Dim sFirstAdd As String, sAdd As String
sFirstAdd = RangeObj.Address
Do
sAdd = RangeObj.Address
With RangeObj.EntireRow 'or limit to just the necessary columns
.Copy 'choose your desired destination
.Delete
End With
Set RangeObj = Cells.SpecialCells(xlCellTypeVisible).FindNext(After:=Range(sAdd))
Loop Until RangeObj Is Nothing Or sAdd = sFirstAdd
End If
I have code like below, but I have problem, I do not know how can I find row where SomeText is included in cell value. If my explanation is not clear example: SomeText = 1200 and want to get row index where cell value are as follow: 1200.0 and 1200.1. Thanks in advance for any help.
Set cell1 = Selection.Find(What:=SomeText, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Just change LookAt:=xlWhole to LookAt:=xlPart
Set cell1 = Selection.Find(What:=SomeText, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)