I need to search "Check" Sheet for values from "Text" sheet.
How can I create a loop for "Text" sheet from cell value A2 to A4 one by one.
I have created below code
Option Explicit
Dim i As Integer
Dim WS, W As Range
Sub Search_fn()
Set WS = Range("B2")
WS = Application.WorksheetFunction.Search(Sheet2.Range("A2"), Range("A2"), 1)
End Sub
This shows 1004 error and I am also not able to crate the loop for all values.
Sheet "Check"
Sheet "text"
Related
I am trying to write an Excel macro that will perform a VLOOKUP on cells 9:100 of column K on 1155 individual sheets (named Page 1, Page 2, etc) of a workbook. I want to run the macro in another workbook, though. So I'm trying to target the cells in one workbook to populate cell values in another.
I have this. However, when I run it, all it does is replace the contents of the specified cells on the first sheet with "#VALUE!". It doesn't do anything to the other sheets.
Sub SearchPages()
Dim i As Integer
Dim cell As Range
Dim value As Variant
Dim result As Variant
Dim wb As Workbook
Set wb = Workbooks.Open("file.xls")
For Each cell In Range("K9:K100")
value = cell.value
result = "Not Found"
For i = 1 To 1155
On Error Resume Next
result = Application.VLookup(value, "Page " & i & "!K:N", 4, False)
On Error GoTo 0
If Not IsError(result) Then
Exit For
End If
Next i
cell.value = result
Next cell
End Sub
Is what I'm trying to do even possible? Any insight is much appreciated!
I have multiple sheets in a workbook. I wan't to copy cells containing SPT values for each Boreholes from the "combine" sheet based on sheetname matching within range listed within "A5:A116" or may be more after final data entry to the sheet matching with the borehole ID /cell value within range "A5:A116" and paste it below the SPT column. This has to continue through a loop process for all the sheets. Also a relative referencing from the matched cell to the range to be copied will be required. In the code the range D5:D16 will have to be a floating ranged based on relative referencing from cell value. Also the paste range will start from 1 cell below the SPT value in the matched.name sheet The code I am working on is as follows the relative referencing for range does not seem to work:
Sub example()
Dim wkSht As Worksheet
For Each wkSht In Sheets
For Each Cell In Sheets("Combine").Range("A5:A116")
If Cell.Value = wkSht.Name Then
On Error Resume Next
Sheets("Combine").Range("D5:D16").Copy Destination:=wkSht.Range("D29:D52")
End If
Next Cell
Next wkSht
End Sub
Data Extraction in different sheets
You sequence for the looping is incorrect, and you did not declare the variable for cell, please try the following code modification and it shall work properly:
Sub example()
Dim wkSht As Worksheet
Dim cell As Range
For Each cell In Sheets("Combine").Range("A5:A116").Cells
For Each wkSht In ThisWorkbook.Worksheets
If cell.Value = wkSht.Name Then
Sheets("Combine").Range(cell.Offset(0, 11), cell.Offset(30, 11)).Copy wkSht.Range("D29")
End If
Next wkSht
Next cell
End Sub
I have code that will open a closed workbook, copy whole data from Worksheet "SM" and paste as values into target workbook "Paste SM" worksheet.
The data comes most of the time with some columns merged. After it has been copied and pasted as values, all merged cells are unmerged and there are some empty rows that need to be filled with duplicates.
Since I do not always receive documents with cells merged the code needs to work within scenarios:
Source Worksheet include merged cell through columns.
EX A1:A11 with value "QWERTY", A12:A23 with value "12345" etc.
Copied and paste as values - all unmerged - A1 - "QWERTY" A2-A11 blanks no value, A12 - "12345" A13-A23 blanks no value.
All blank cells to fill with duplicates, check whole worksheet.
Source Worksheet contains unmerged and merged cells.
Merged cells - same logic as for point 1.
Unmerged cells would look like A1 - "QWERTY" A2-A11 blanks no value, A12 - "12345" A13-A23 blanks no value in source worksheet.
It will remain same after copy and paste as values.
All blank cells to fill with duplicates, check whole worksheet.
Option Explicit
Public Sub Import_SM_DataFromAnotherWorkbook_and_Paste_As_Values()
' Get workbook...
Dim targetWorkbook As Workbook
Set targetWorkbook = Application.ThisWorkbook
' get the customer workbook
Dim Filter As String
Filter = "Text files (*.xlsb),*.xlsb,(*.xlsx),*.xlsx"
Dim Caption As String
Caption = "Please Select an input file "
Dim Ret As Variant
Ret = Application.GetOpenFilename(Filter, , Caption)
If VarType(Ret) = vbBoolean And Ret = False Then Exit Sub
Dim wb As Workbook
Set wb = Workbooks.Open(Ret)
'It will open source woorkbook, copy whole sheet and paste as values into current workbook. Will
close sourcebook afterwards
targetWorkbook.Worksheets("Paste SM").Range("A1").Resize(wb.Worksheets("Security Matrix").UsedRange.Rows.Count, wb.Worksheets("Security Matrix").UsedRange.Columns.Count).Value = wb.Worksheets("Security Matrix").UsedRange.Value
'close opened workbook without saving
wb.Close SaveChanges:=False
End Sub
instead of copy and paste all the new data to a new worksheet, you should create an array with all the data. Check all the values of the array and if it's empty, copy the value from the row above.
Option Base 1 'make the array starts at 1 instead of 0. This is helpful because you are working as it was a range
Dim ArrayNewData(), NewRange As Range, RangeNewData As Range
Dim i%, j%
Sub Test()
'when open the new worksheet
With wb.Sheets("SM")
Set RangeNewData = .Cells(1, 1).CurrentRegion 'set the range you want to copy
End With
ArrayNewData = RangeNewData 'save the copied range to an array.
'now you can close the wb
wb.Close SaveChanges:=False
'The size of the array is
'Rows:lbound(ArrayNewData) x ubound(ArrayNewData)
'Columns: lbound(application.transpose(ArrayNewData)) x ubound(application.transpose(ArrayNewData))
'all the "cells" in the array aren't merged
'so now, you can fill the empty "cells" of the array with the value above
For i = 2 To UBound(ArrayNewData) 'check all the rows starting from the 2nd (just because if the 1st one is empty, there's nothing to copy above
For j = 1 To UBound(Application.Transpose(ArrayNewData)) 'and check all the columns
If IsEmpty(ArrayNewData(i, j)) = True Then 'if the cell is empty...
ArrayNewData(i, j) = ArrayNewData(i - 1, j) 'the value will be the one row above
End If
Next j
Next i
'Now you've got the array of values ArrayNewData.
'Now set a new range to where you want to copy them. Maybe, you don't need to copy all of them, andkeep working with the array.
'The more interactions you do between VBA and excel, the more slow will work everything.
With Sheets("Paste SM")
Set NewRange = .Range(.Cells(1, 1), .Cells(UBound(ArrayNewData)), UBound(Application.Transpose(ArrayNewData)))
End With
NewRange = ArrayNewData
End Sub
Is it possible to match the range size of sheet 2 with the selected range in sheet 1?
First select Sheet1 and then select some block of cells. After running this macro:
Sub MatchRange()
Dim ady As String
ady = Selection.Address
Sheets("Sheet2").Select
Range(ady).Select
End Sub
you will be on Sheet2 with the same block selected.
Unfortunately for my employer, none of my network engineering courses included advanced Excel formula programming. Needless to say, I know nothing about Excel save for basic SUM and COUNT formula commands.
My employer has an Excel workbook with multiple worksheets within it representing each month of the calendar year. We want to be able to have a "total" worksheet in the workbook that reflects all data across the entire workbook in each column/row.
An example for the sake of clarity:
In the worksheet "May_2013", column A is labeled "DATE". Cell A2 contains the data "MAY-1".
In the worksheet "June_2013", column A is labeled "DATE". Cell A2 contains the data "JUNE-1".
In the worksheet "Total", column A is labeled "DATE". We want cells A2 to reflect "MAY-1" and A3 to reflect "JUNE-1".
We want to do this for all worksheets, columns A-Q, rows 2-33 and populate a master sheet at the very end containing all data in all worksheets in their corresponding columns.
Is this possible?
Here are two VBA solutions. The first does this:
Check if a sheet "totals" exists. Create it if it does not
Copy the first row (A to Q) of first sheet to "totals"
Copy block A2:Q33 to "totals" sheet starting at row 2
Repeat for all other sheets, appending 32 rows lower each time
The second shows how to do some manipulation of the column data before copying: for each column it applies the WorksheetFunction.Sum(), but you could replace that with any other aggregating function that you would like to use. It then copies the result (one row per sheet) to the "totals" sheet.
Both solutions are in the workbook you can download from this site. Run the macros with , and pick the appropriate one from the list of options that shows up. You can edit the code by invoking the VBA editor with .
Sub aggregateRaw()
Dim thisSheet, newSheet As Worksheet
Dim sheetCount As Integer
Dim targetRange As Range
sheetCount = ActiveWorkbook.Sheets.Count
' add a new sheet at the end:
If Not worksheetExists("totals") Then
Set newSheet = ActiveWorkbook.Sheets.Add(after:=Sheets(sheetCount))
newSheet.Name = "totals"
Else
Set newSheet = ActiveWorkbook.Sheets("totals")
End If
Set targetRange = newSheet.[A1]
' if you want to clear the sheet before copying data, uncomment this line:
' newSheet.UsedRange.Delete
' assuming you want to copy the headers, and that they are the same
' on all sheets, you can copy them to the "totals" sheet like this:
ActiveWorkbook.Sheets(1).Range("1:1").Copy targetRange
Set targetRange = targetRange.Offset(1, 0) ' down a row
' copy blocks of data from A2 to Q33 into the "totals" sheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> newSheet.Name Then
ws.Range("A2", "Q33").Copy targetRange
Set targetRange = targetRange.Offset(32, 0) ' down 32 rows
End If
Next ws
End Sub
Sub aggregateTotal()
Dim thisSheet, newSheet As Worksheet
Dim sheetCount As Integer
Dim targetRange As Range
Dim columnToSum As Range
sheetCount = ActiveWorkbook.Sheets.Count
' add a new sheet at the end:
If Not worksheetExists("totals") Then
Set newSheet = ActiveWorkbook.Sheets.Add(after:=Sheets(sheetCount))
newSheet.Name = "totals"
Else
Set newSheet = Sheets("totals")
End If
' assuming you want to copy the headers, and that they are the same
' on all sheets, you can copy them to the "totals" sheet like this:
Set targetRange = newSheet.[A1]
ActiveWorkbook.Sheets(1).Range("A1:Q1").Copy targetRange
Set targetRange = targetRange.Offset(1, 0) ' down a row
For Each ws In ActiveWorkbook.Worksheets
' don't copy data from "total" sheet to "total" sheet...
If ws.Name <> newSheet.Name Then
' copy the month label
ws.[A2].Copy targetRange
' get the sum of the coluns:
Set columnToSum = ws.[B2:B33]
For colNum = 2 To 17 ' B to Q
targetRange.Offset(0, colNum - 1).Value = WorksheetFunction.Sum(columnToSum.Offset(0, colNum - 2))
Next colNum
Set targetRange = targetRange.Offset(1, 0) ' next row in output
End If
Next ws
End Sub
Function worksheetExists(wsName)
' adapted from http://www.mrexcel.com/forum/excel-questions/3228-visual-basic-applications-check-if-worksheet-exists.html
worksheetExists = False
On Error Resume Next
worksheetExists = (Sheets(wsName).Name <> "")
On Error GoTo 0
End Function
Final(?) edit:
If you want this script to run automatically every time someone makes a change to the workbook, you can capture the SheetChange event by adding code to the workbook. You do this as follows:
open the Visual Basic editor ()
In the project explorer (left hand side of the screen), expand the VBAProject
Right-click on "ThisWorkbook", and select "View Code"
In the window that opens, copy/paste the following lines of code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' handle errors gracefully:
On Error GoTo errorHandler
' turn off screen updating - no annoying "flashing"
Application.ScreenUpdating = False
' don't respond to events while we are updating:
Application.EnableEvents = False
' run the same sub as before:
aggregateRaw
' turn screen updating on again:
Application.ScreenUpdating = True
' turn event handling on again:
Application.EnableEvents = True
Exit Sub ' if we encountered no errors, we are now done.
errorHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
' you could add other code here... for example by uncommenting the next two lines
' MsgBox "Something is wrong ... " & Err.Description
' Err.Clear
End Sub
Kindly use RDBMerge add-in which will combine the data from different worksheet and create a master sheet for you. Please see the below link for more details.
http://duggisjobstechnicalstuff.blogspot.in/2013/03/how-to-merge-all-excel-worksheets-with.html
Download RDBMerge
You can use the indirect function to reference the sheet name. In the image below this function takes the header name (B37) and uses it as the sheet reference. All you have to do is choose the correct "total cell" which I made "A1" in "MAY_2013". I put an image below to show you my reference name as well as tab name