Different sheet pasting - vba

I have written a code which gives me the errors (if any cell is non numeric) in a separate sheet called "Error_sheet".
But the output is a bit clumsy as it gives me non numeric cell address in a confusing fashion. Like the errors will not be pasted one after another. There will be some blanks in between if there are more than one non Numeric cells.
Sub Test()
Dim LastRow As Long, i As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
If IsNumeric(Range("A" & i).Value) Then
Else
Sheets("Error").Range("A" & Row).Value = "Error in" & i & " row of ColumnNAme"
Row = Row + 1
End If
Next i
End Sub
It gives me output like shown below but can I get the output like Error in 7,14 rows of column name in a desired cell of "Error_sheet".
[![Output][1]][1]
[1]: https://i.stack.imgur.com/JqXwq.png

My understanding of what you've written is that you want something like this.
Option Explicit
Sub Test()
' Unqualified book/sheet below, means code will always run the isnumeric check on the cells of the active sheet. Is that what you want? '
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Dim Index as long
Dim i As Long
Dim NonNumericRows() as string
Redim NonNumericRows(1 to lastrow)
For i = 2 To LastRow
If not(IsNumeric(Range("A" & i).Value)) Then
Index = index + 1
NonNumericRows(Index) = cstr(i)
End if
Next i
Redim preserve NonNumericRows(1 to index)
Sheets("Error").Range("A1").Value = "Error in row(s): " & strings.join(nonnumericrows,", ") & " of ColumnNAme"
End Sub
Hope it works or helps.

Like QHarr suggested, using Option Explicit is normally a good idea, and try not to use VBA operators as variables.
Also when working with more than 1 sheet, its best to define each in the code. I dont know what your first sheet is called, so please change the line: Set shSource = Sheets("Sheet1") to suit:
Option Explicit
Sub SubErrorSheet()
Dim lr As Long, i As Long
Dim shSource As Worksheet, shError As Worksheet
Set shSource = Sheets("Sheet1")
Set shError = Sheets("Error")
lr = shSource.Range("A" & Rows.count).End(xlUp).Row
For i = 2 To lr
If Not IsNumeric(shSource.Range("A" & i).Value) Then
shError.Range("A" & Rows.count).End(xlUp).Offset(1, 0).Value = "Error in row " & i & " of ColumnNAme"
End If
Next i
End Sub

Related

VBA: Addition in cells

I'm sorting through data and need it to be formatted the same way. The input might have cells with
6+18
12
3
5+14
20
And I want to make them all integers. I've written this so far:
If InStr(data.Cells(x, 8), "+") > 0 Then
'Still trying to figure out this part
Else
calc.Cells((lrcalc + 1), (col + s)).Value = data.Cells(x, 8)
End If
How would I add the value on the left of the "+" sign to the value on the right?
Well there is no need to check for +. Simply add an = sign in each cell and let excel calculate it ;)
Sub Sample()
Dim lRow As Long, i As Long
Dim ws As Worksheet
'~~> Change this to the relevant sheet
Set ws = ActiveSheet
With ws
'~~> Find last row
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 1 To lRow
With .Range("A" & i)
.Formula = "=" & .Value
.Value = .Value
End With
Next i
End With
End Sub
Screenshot

I need to create new sheets based on unique names found in column A. Current Code generates excess data in certain sheets

I have the following code so far based on questions asked by other people.
I have a set of names listed in column A, and 216 columns and 9725 rows of data.
Currently using the following code I get the new sheets created except along with the unique names and its relevant data I get many cells filled with "#N/A".
In certain cases, the name Bob for example will be populated in a new sheet called Bob but the first column will have Bob and all relevant data and once all Bobs rows are shown it is follower with many rows with #N/A and all columns with #N/A.
In other cases the sheet will be created for Charles and all of Charles data will be listed, then many rows of #N/A and then all of the master-data including other peoples names which I need to avoid.
I want each individual sheet to only have the info based on the name of the person on that sheet. All of the data gets copied as I verified the number of accurate cells that get populated yet I get these #N/A cells and duplicated extra data and I'm not sure how to stop it from being populated? Any help in cleaning the code would be appreciated!!
Code:
Sub CopyDataFromReportToIndividualSheets()
Dim ws As Worksheet
Set ws = Sheets("FormulaMSheet2")
Dim LastRow As Long
Dim MyRange As Range
Worksheets("FormulaMSheet2").Activate
LastRow = Range("A" & ws.Rows.Count).End(xlUp).Row
' stop processing if we don't have any data
If LastRow < 2 Then Exit Sub
Application.ScreenUpdating = False
' SortMasterList LastRow, ws
CopyDataToSheets LastRow, ws
ws.Select
Application.ScreenUpdating = True
End Sub
Sub SortMasterList(LastRow As Long, ws As Worksheet)
ws.Range("A2:BO" & LastRow).Sort Key1:=ws.Range("A1")
', Key2:=ws.Range("B1")
End Sub
Sub CopyDataToSheets(LastRow As Long, src As Worksheet)
Dim allAgentNameCells As Range
Dim cell As Range
Dim Series As String
Dim SeriesStart As Long
Dim SeriesLast As Long
Set allAgentNameCells = Range("A2:A" & LastRow)
SeriesStart = 2
Series = Range("A" & SeriesStart).Value
For Each cell In allAgentNameCells
If cell.Value <> " " And cell.Value <> "" Then
' Condition ` And cell.Value <> "" ` added for my testdata. If you don't need this, please remove.
' Current Row's Series not SPACE
If cell.Value <> Series Then
SeriesLast = cell.Row - 1
CopySeriesToNewSheet src, SeriesStart, SeriesLast, Series
Series = cell.Value
SeriesStart = cell.Row
End If
End If
Next
'' copy the last series
SeriesLast = LastRow
CopySeriesToNewSheet src, SeriesStart, SeriesLast, Series
End Sub
Sub CopySeriesToNewSheet(src As Worksheet, Start As Long, Last As Long, name As String)
Dim tgt As Worksheet
Dim MyRange As Range
If (SheetExists(name)) Then
MsgBox "Sheet " & name & " already exists. " _
& "Please delete or move existing sheets before" _
& " copying data from the Master List.", vbCritical, _
"Time Series Parser"
End
Else
If Series = " " Then
End
End If
End If
Worksheets("FormulaMSheet2").Activate
' Worksheets.Add(after:=Worksheets(Worksheets.Count)).name = name
Worksheets("FormulaMSheet2").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.name = name
Set tgt = Sheets(name)
' copy data from src to tgt
tgt.Range("A2:BO2" & Last - Start + 2).Value = src.Range("A" & Start & ":BO" & Last).Value
End Sub
Function SheetExists(name As String) As Boolean
Dim ws As Variant
For Each ws In ThisWorkbook.Sheets
If ws.name = name Then
SheetExists = True
Exit Function
End If
Next
SheetExists = False
End Function
You need replace the
tgt.Range("A2:BO2" & Last - Start + 2).Value = src.Range("A" & Start & ":BO" & Last).Value
to
src.Range("A" & Start & ":BO" & Last).SpecialCells(xlCellTypeVisible).Copy Destination:=tgt.Range("A2:BO2" & Last - Start + 2)
I found what I needed at the following site: http://www.rondebruin.nl/win/s3/win006_5.htm .
I figured if anyone else was looking for similar code it would help taking a look at the site.

Need to find the last row in a spreadsheet before copying and pasting data from Sheet 1 to Sheet 2

This site has helped me immensely with VBA for a while now, so thanks for that! But I just can't seem to get this code to work and I've look at so many examples. What's happening is that I'm archiving data on another sheet once the current date is 4 days ahead of the due date. Everything works like it should, but every time the macro executes, the data on sheet2 is erased and copied over. I need my code to find the last row on sheet2 and copy the data from sheet1 to sheet2 so all the data is there. Thanks!
Sub archive()
Dim LastRow As Long
Dim i As Long
LastRow = Range("M" & Rows.Count).End(xlUp).Row
For i = 3 To LastRow
If Worksheets("Sheet1").Range("M" & i) - Date <= -4 And Worksheets("Sheet1").Range("N" & i).Value = "DONE" Then
Sheet2.Select
Range("A" & i).EntireRow.Value = Sheet1.Range("M" & i).EntireRow.Value
Sheet1.Range("M" & i).EntireRow.Delete
End If
If Worksheets("Sheet1").Range("L" & i) = "" Then
Exit For
End If
Next i
End Sub
Here I've taken your code and changed it to use worksheet objects. I've not tested this on any data as you haven't provided any to use, but it gives you an idea of how to implement it.
Also, in your code you weren't finding the last row of Sheet2, you were putting the data in row i, which starts at 3.
You also need to watch out when you delete the row of data from sheet1, as this shifts the rest of the data up, so the next iteration of the loop may not find the next row of data/ skip a row of data.
Sub archive()
Dim LastRow As Long
Dim LastRowSht2 As Long
Dim i As Long
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim rowCount As Long
Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")
LastRow = sht1.Range("M" & Rows.Count).End(xlUp).Row
rowCount = 3
For i = 3 To LastRow
If sht1.Range("M" & rowCount) - Date <= -4 And sht1.Range("N" & rowCount).Value = "DONE" Then
LastRowSht2 = sht2.Range("A" & Rows.Count).End(xlUp).Row + 1 '+1 so it doesn't overwrite the last row
sht2.Range("A" & LastRowSht2).EntireRow.Value = sht1.Range("M" & rowCount).EntireRow.Value
sht1.Range("M" & rowCount).EntireRow.Delete
Else
rowCount = rowCount + 1
End If
If sht1.Range("L" & rowCount) = "" Then
Exit For
End If
Next i
' clean up
set sht1 = nothing
set sht2 = nothing
End Sub

Dynamically set Ranges to the columns in VBA

I am importing some date to worksheet which needs to be ranged for validation and reference in other worksheets.
Say I have 4 columns in worksheet(WS1) but the row count is dynamic on every import. How can i range the columns(A:D)?
Please help.
Regards,
Mani
Use a lastRow variable to determine the last row. I included a few examples of this. Also on this example is a lastCol variable.. You can use this if the number of Columns is dynamic as well.
Private Sub lastRow()
Dim lastRow As Long
Dim lastCol As Long
Dim sheet As String
sheet = "WS1"
lastRow = Sheets(sheet).Range("A" & Rows.Count).End(xlUp).row 'Using Range()
lastRow = Sheets(sheet).Cells(Rows.Count, "A").End(xlUp).row 'Using Cells()
lastCol = Sheets(sheet).Cells(2, Columns.Count).End(xlToLeft).Column
End Sub
You can loop through your sheet easily enough using variables also. Using Cells(row,col) instead of Range(A1). you can use numbers or a letter in quotes for the column as shown in the example.
This example looks at WS1 and matches someValue. If the value in Column A of WS1 = somevalue, the record is copied to a "Master" Sheet.
Sub LoopExample()
Dim mRow As Long 'used for a master row
For lRow = 2 To lastRow
If Sheets(sheet).Cells(lRow, 1) = someValue Then
'perform something here like this. Copy columns A:D to the Master Sheet if match
For lCol = 1 To 4 'or you could go 1 to lastCol if you needed it dynamic
Sheets("MASTER").Cells(mRow, lCol) = Sheets(sheet).Cells(lRow, lCol) 'mRow as Row on Master
Next lCol
mRow = mRow + 1 'Increment the Master Row
End If
Next lRow
End Sub
Thanks anyways. But what i wanted was just to Name ranges the columns in worksheet.
I have already accomplished the copy and paste (Loading data b/w worksheets).
This is what i wanted.
vRowCount = DestWorkSheet.Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
vColCount = DestWorkSheet.Cells(1, 1).SpecialCells(xlCellTypeLastCell).Column
DestWorkSheet.usedRange.Columns.AutoFit
AddNamedRange Dest_RATES, DATA_Dest_RATES
Where AddNamedRange is a function,
Public Sub AddNamedRange(ByVal sheetCodeName As String, ByVal namedRange As String)
Dim rngToBeNamed As Range
Dim ws As Worksheet
On Error GoTo AddNamedRange_Error
Set rngToBeNamed = GetUsedRange(sheetCodeName)
Set ws = rngToBeNamed.Worksheet
ws.Names.Add name:=namedRange, RefersTo:=ws.Range(rngToBeNamed.Address)
On Error GoTo 0
Exit Sub
AddNamedRange_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure AddNamedRange of Module UtilitiesRange"
End Sub
Regards,
Mani
Seems like you could just use something like this in the sheet module:
Private Sub Worksheet_Change(ByVal target As Range)
Dim i As Long
Dim NamesOfNames(1 To 4) As String
NamesOfNames(1) = "NameOfColumn1"
NamesOfNames(2) = "NameOfColumn2"
NamesOfNames(3) = "NameOfColumn3"
NamesOfNames(4) = "NameOfColumn4"
For i = 1 To 4
ThisWorkbook.Names.Add Name:=NamesOfNames(i), _
RefersTo:=Range(Cells(1, i), Cells(Cells(Rows.Count, i).End(xlUp).Row, i))
Next i
End Sub

How to return value from VLOOKUP into a cell?

I have the following piece of code for Vlookup. The function works fine but the found out value aint getting displayed in the cell. However if i had a used Msgbox function the found out value is shown. The question is doesnt VLOOKUP result be captured in a cell?
Sub Example_of_Vlookup()
Dim lookFor As Range
Dim rng As Range
Dim col As Integer
Dim found As String
Dim lastrowrange As Long
Dim area As Range
lastrowrange = [A65536].End(xlUp).Row
Set lookFor = Sheets("Sheet2").Range("b2")
Set rng = Sheets("Sheet2").Columns("t:u")
Set taxRange = Range("f2", Cells(lastrowrange, 22))
col = 2
On Error Resume Next
For i = 1 To lastrowrange
found = Application.VLookup("B2", "T1:U4", 2, True)
If IsError(found) Then
MsgBox lookFor & " not found"
Else
area.Cells(i, 2).Value = found
End If
Next i
On Error GoTo 0
End Sub
You did not set the range "area" equal to anything, so this line won't show your answer properly:
area.Cells(i, 2).Value = found
Change area.Cells(i,2).value to sheets("Sheet2").Cells(i,2).value or wherever you want your answer to show. Or, set area equal to something if you want to use area.cells.
Idea is simple - I have country names in Column B.Inention is to pull out the Area under which country belongs - My look up values are in column S(country) and T(area) and display the result in column F – Sayanth Sasidharan 25 mins ago
If my understanding is correct as per your explanation then you do not need to use a loop. Let Excel do the Dirty Work ;) You will end up with far less code.
Let's say your sheet looks like this
Logic:
Find the last row of Col B
Insert the Vlookup formula in F1:F & LastRow in one go
Convert them to values.
Code:
Option Explicit
Sub Example_of_Vlookup()
Dim ws As Worksheet
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Sheet2")
With ws
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
'~~> =IF(ISERROR(VLOOKUP(B1,S:T,2,0)),"",VLOOKUP(B1,S:T,2,0))
.Range("F1:F" & lRow).Formula = _
"=IF(ISERROR(VLOOKUP(RC[-4],C[13]:C[14],2,0)),"""",VLOOKUP(RC[-4],C[13]:C[14],2,0))"
.Range("F1:F" & lRow).Value = .Range("F1:F" & lRow).Value
End With
End Sub
Result: