Hi so I am not too experienced in Excel VBA. I am trying to find the values in one excel workbook in another excel workbook, then copy the corresponding B, F and K column and insert it into the B5,C5 and D5 columns.
This is what I have done so far.
Sub findsomething()
Dim rng As Range
Dim account As String
Dim rownumber As Long
Dim dehyp As Long
dehyp = Replace(Range("A5").Value, "-", "")
account = Sheet.Cells(dehyp)
Set rng = sheet1.List-of-substances-in-the-third-phase-of-CMP-(2016-
2021).xlsx.Columns("A:A").Find(What:=account,
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
rownumber = rng.Row
Sheet1.Cells(2, 2).Value = Sheet1.List-of-substances-in-the-third-
phase-of-CMP-(2016-2021).xlsx.Cells(rownumber,
3).Value
End Sub
I have tried till the open work book part of the code and it works, but have not tested anything past it because I don't know how to do the column find.
Any help is appreciated
..............................................................................Edit: I have reformated it to include the find statement and thought maybe I do not have to open the second workbook. I am not sure what is wrong and am getting compilation errors.
Related
Making a sheet where the user can select an area from a drop down, and then cells containing info relevant to that area are shown in column T.
The data is formatted in such a way that the areas are the headings across the columns from A1:Q1. Then on each column is a combination of blank cells and cells that contain the info needed.
This shows a simplified example of what I'd like to do. Obviously the X's pertain to actual info.
I've got a code that I think should work, but it's not.... The first section does successfully find the right column from the sheet using whatever is in the drop down. But then the copy paste loop that looks for blank cells does not seem happy, and doesn't want to use the address I found from the find section.
I did explore the idea of using index/match/array, but couldn't get my head round it.
Sub NonBlank()
Dim Found As Range
Dim Clm As String
Dim rngSearch As Range
Dim Criteria As Variant
Dim cell As Range
Criteria = Sheets("Example").Range("S3").Value
Set rngSearch = Sheets("Example").Range("A1:Q1")
Set Found = rngSearch.Find(What:=Criteria, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Found Is Nothing Then
Clm = Found.Address(rowabsolute:=False)
Dim datatocopy As Range
Set datatocopy = Sheets("example").Range("clm").SpecialCells(xlCellTypeConstants)
If Not datatocopy Is Nothing Then
datatocopy.Copy Destination:=Sheets("Example").Range("T3")
End If
End If
End Sub
Any help is much appreciated. :)
If the values are constants and no formulas you don't need to loop through the data and can just use SpecialCells(xlCellTypeConstants) on the range to get all constant values (without the blank cells).
Dim DataToCopy As Range
Set DataToCopy = Sheets("Table").Range("B1:B6").SpecialCells(xlCellTypeConstants)
If Not DataToCopy Is Nothing Then
DataToCopy.Copy Destination:=Sheets("Table").Range("G2")
End If
The following should work
Sub NonBlank()
Dim Criteria As Variant
Criteria = Sheets("Example").Range("S3").Value
Dim rngSearch As Range
Set rngSearch = Sheets("Example").Range("A1:Q1")
Dim Found As Range
Set Found = rngSearch.Find(What:=Criteria, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Found Is Nothing Then
Dim datatocopy As Range
Set datatocopy = Found.EntireColumn.Resize(RowSize:=Rows.Count-1).Offset(RowOffset:=1).SpecialCells(xlCellTypeConstants)
If Not datatocopy Is Nothing Then
datatocopy.Copy Destination:=Sheets("Example").Range("T3")
End If
End If
End Sub
I'm trying to copy data from a column in a sheet called "KPI", in cells H6:H100, to a specific row in a sheet named "table". The row depends on two variables in the KPI sheet which user selects from drop downs in C2:D2.
I have managed to get the code to find the right row each time by searching columns A then B in the "data" sheet.But when it comes to the copy paste/transpose column H from "KPI" sheet into the right row on the "table" sheet it throws up a 424 error.
I might be missing something really obvious so any help is appreciated.
Sub copy_transpose()
Dim rng_source As Range
Dim Found As Range, Firstfound As String
Dim rngSearch As Range
Dim Criteria As Variant
Set rng_source = ThisWorkbook.Sheets("KPI").Range("H6:H100")
Set rngSearch = Sheets("Table").Range("A:A")
Criteria = Sheets("KPI").Range("C2:D2").Value
Set Found = rngSearch.Find(What:=Criteria(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Found Is Nothing Then
Firstfound = Found.Address
Do
If Found.EntireRow.Range("B2").Value = Criteria(1, 2) Then Exit Do 'Match found
Set Found = rngSearch.FindNext(After:=Found)
If Found.Address = Firstfound Then Set Found = Nothing
Loop Until Found Is Nothing
End If
If Not Found Is Nothing Then
Application.Goto Found
rng_source.Copy
Sheets("Table").Range(cell.Offset(0, 1), cell.Offset(0, 7)).PasteSpecial Transpose:=True
Else
MsgBox ("Error")
End If
End Sub
I needed more coffee. I hadn't spotted that is was referencing "cell" instead of "found".
Today I learned that "cell" is not a vba function, and was actually something I had dimensioned in my older code, and was the equivalent of "found".
I've got part of a solution but it isn't working like I'd hope, so I've come to you for advice.
I regularly receive Excel files where I need to amend formatting. I'm trying to learn VBA by automating as much of these procedures as possible.
One particular format I complete is converting the date to "DDMMYYYY" (09091986), where it usually comes in as 09/09/1986.
Within my worksheet, there are a total of 3 columns containing dates, all of which need the same formatting and all of which have the word "DATE" in the heading. They are not adjacent to each other.
I must also be careful not to have any other data affected, as I have names and addresses which may contain the characters "DATE".
So, background out of the way... I'm trying to search the first row until I find the word "Date" and then format that for each cell until the last row, before moving on to the next column containing the word "DATE" and repeating this until all columns with the word "DATE" have been formatted.
I'm sure you have a simple solution but I can't seem to find it myself.
Here is the code I have...
Sub Dateformat()
Dim LastRow As Integer
Dim FindCol As Integer
Dim C1 As Integer
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
FindCol = Cells.Find(What:="DATE", LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
For C1 = 2 To LastRow
Cells(C1, FindCol).NumberFormat = "DDMMYYYY"
Next C1
End Sub
This works for the first column containing date but doesn't move on to the next column.
Thanks for the help
Regards,
Adam
As you know, you need to loop through and find each Row Header with DATE
Here is one way to do it.
Sub Dateformat()
Dim wks As Worksheet
Dim LastRow As Integer
Dim FindCol As Range
Dim sAdd As String
Set wks = ThisWorkbook.Sheets("Sheet1") ' adjust as needed
With wks
LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'find first instance where DATE exists in row 1 (headers)
Set FindCol = .Rows(1).Find(What:="DATE", LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
'store address of first found instance (to check in loop)
sAdd = FindCol.Address
Do
'format column (row 2 to last used row)
.Range(.Cells(2, FindCol.Column), .Cells(LastRow, FindCol.Column)).NumberFormat = "DDMMYYYY"
'this line works as well and is a bit cleaner
'.Cells(2, FindCol.Column).Resize(LastRow - 1, 1).NumberFormat = "DDMMYYYY"
'find next instance (begin search after current instance found)
Set FindCol = .Cells.FindNext(After:=FindCol)
'keep going until nothing is found or the loop finds the first address again (in which case the code can stop)
Loop Until FindCol Is Nothing Or FindCol.Address = sAdd
End With
End Sub
I know this has probably already been answered but I have searched through the previous questions and cannot find an answer that works for me.
Basically I have an excel spreadsheet which can be updated daily/weekly/monthly depending on the workflow. What I need is a macro that finds the last 'used' column(Headers are in row 5), inserts a blank column directly to the right of that - (we have a totals table at the end that needs to move along) & copies the entire last used columns data into that newly created column.
It's probably quite a simple code but I've only just started using VBA and hope someone can help!! I'm hoping once I've started doing some bits and pieces I can build up my knowledge!
Thanks in advance
Emma
From here: Copy last column with data on specified row to the next blank column and here: Excel VBA- Finding the last column with data
Sub Test()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim rLastCell As Range
Dim LastCol As Integer
Set rLastCell = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
LastCol = rLastCell.Column
ws.Columns(LastCol).Copy ws.Columns(LastCol + 1)
End Sub
Lazy minimalist solution:
Sub Macro1()
Dim col As Integer
col = Range("A5").End(xlToRight).Column
Columns(col).Copy
Columns(col + 1).Insert Shift:=xlToRight
End Sub
Though this will crash if there's nothing in cell A5.
I am currently having issues with a Macro I am programming for Excel 2013 regarding reading hidden columns. I am trying to utilize Column A as a row of unique keys to allow me to quickly develop logic that hides and shows a row based on the key value in column A. When I hide column A manually in the sheet for visual purposes I am then unable to read from that column, aka my code returns an error. If I show the column the code executes clearly. Thanks in advance for the help!
Public Sub hideRow(findId As String, sheetName As String)
Dim lastRow As Long
Dim foundCell As Range
Dim hideThisRowNum As Integer
'Get Last Row
lastRow = Worksheets(sheetName).Range("A" & Rows.Count).End(xlUp).Row
'Find ID
With Worksheets(sheetName).Range("a1:a1000") 'This needs to be A1 to AxlDown
Set foundCell = Worksheets(sheetName).Range("A1:A" & lastRow).Find(What:=findId, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
End With
'Get Row # to Hide
hideThisRowNum = Val(foundCell.Row)
'Hide row
Worksheets(sheetName).Rows(hideThisRowNum).Hidden = True
'Set Add To Action Plan = No
Worksheets(sheetName).Range("G" & hideThisRowNum).Value = "No"
End Sub
The problem is in the .Find() call. Using LookIn:=xlValues won't find hidden cells. Change it to LookIn:=xlFormulas and it should work.