Excel VBA Error Doing Multiple Row Multiplication - excel

Gettin a "Type Mismatch" error.
Trying to take one matrix of numbers on one worksheet "Sheet1", divide by another matrix of numbers on a second worksheet "Sheet2", then show each cell result on a matrix on the third worksheet "Sheet1"
Sub MacroTest()
Worksheets("Sheet3").Range("C5") = Worksheets("Sheet1").Range("C5:DR124") / Worksheets("Sheet2").Range("C5:DR124")
End Sub

With this code you can do what you need on specific range (that you can choose) on different sheet and also on the same sheet.
Sub RangeDiv()
Dim RngFrom As Range
Dim RngDiv As Range
Dim RngTo As Range
Dim R As Integer
Dim C As Integer
Set RngFrom = Sheets(1).Range("A1:E3")
Set RngDiv = Sheets(1).Range("B6:F8")
Set RngTo = Sheets(1).Range("C10:G12")
'Check if all Rngs have the same number of rows and columns
If RngFrom.Rows.Count <> RngDiv.Rows.Count Or RngFrom.Rows.Count <> RngTo.Rows.Count Then
MsgBox ("Rngs rows number aren't equal")
Exit Sub
End If
If RngFrom.Columns.Count <> RngDiv.Columns.Count Or RngFrom.Columns.Count <> RngTo.Columns.Count Then
MsgBox ("Rngs columns number aren't equal")
Exit Sub
End If
For C = 1 To RngFrom.Columns.Count
For R = 1 To RngFrom.Rows.Count
'check cell value to avoid errors coming from dividing by 0
If Val(RngDiv.Cells(R, C)) <> 0 Then
RngTo.Cells(R, C) = RngFrom.Cells(R, C) / RngDiv.Cells(R, C)
Else
'Insert something when division is impossible
RngTo.Cells(R, C) = 0 'Or what you want to insert
End If
Next R
Next C
End Sub

I create sheet1 like this
Please click to see Image
then sheet2
Please click to see Image2
then create blank sheet 3
and use this code
Sub divideRange()
Dim lastRow, lastColumn As Long
lastColumn = Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
lastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastRow
For j = 1 To lastColumn
Sheets("Sheet3").Cells(i, j).Value = Sheets("Sheet1").Cells(i, j).Value / Sheets("Sheet2").Cells(i, j).Value
Next j
Next i
End Sub
Is this what you want?

Sorry for my late reply.
You can solve your problem with a for-loop:
For i = 3 To 9
If IsNumeric(Worksheets("Tabelle2").Cells(5, i).Value) And IsNumeric(Worksheets("Tabelle3").Cells(5, i).Value) And Worksheets("Tabelle3").Cells(5, i).Value <> 0 Then
Worksheets("Tabelle1").Cells(5, i).Value = Worksheets("Tabelle2").Cells(5, i).Value / Worksheets("Tabelle3").Cells(5, i).Value
End If
Next
variable i is your column as a number. A = 1, B = 2, Z = 26, AA = 27 and so on..
number 5 is your row
For example
Cells(5,1) is the same like Range("A5") or Cells(3,9) = Range("I3")
In my code above, it starts with column C (3) and stops with column I (9). Replace the Number 9 with the number of the Column FX (your last column) and edit the table Names then it should work.

Related

Why is my array returning empty? And how do I ensure it copies the data into my third selection

After countless efforts to keep the array "newvarray" within range, I am now running into a result of an empty array from a 278 line column. I believe this is also the root cause of my endgame function not executing (pasting unmatched values into the rolls sheet)?
Clarification: the actualy empty cells report on locals as "Empty", the columns with string report as " "" "
Dim oldsht As Worksheet
Dim newsht As Worksheet
Dim rollsht As Worksheet
Dim a As Integer
Dim b As Integer
Dim c As Integer
Set oldsht = ThisWorkbook.Sheets("Insert Yesterday's Report Here")
Set newsht = ThisWorkbook.Sheets("Insert Today's Report Here")
Set rollsht = ThisWorkbook.Sheets("Rolls")
Dim OldVArray(), NewVArray(), RollArray() As String
ReDim Preserve OldVArray(1 To oldsht.Range("a" & Rows.Count).End(xlUp).Row - 1, 5 To 5)
ReDim Preserve NewVArray(2 To newsht.Range("a" & Rows.Count).End(xlUp).Row, 5 To 5)
ReDim Preserve RollArray(1 To rollsht.Range("a" & Rows.Count).End(xlUp).Row - 1, 3 To 3)
For a = 2 To oldsht.Range("E" & Rows.Count).End(xlUp).Row
OldVArray(a, 5) = oldsht.Cells(a, 5)
Next a
For b = 2 To newsht.Range("E" & Rows.Count).End(xlUp).Row
NewVArray(b, 5) = newsht.Cells(b, 5)
Next b
For c = 2 To rollsht.Range("C" & Rows.Count).End(xlUp).Row
RollArray(c, 3) = rollsht.Cells(c, 3)
Next c
Dim Voyage As String
For a = 2 To UBound(OldVArray)
Voyage = OldVArray(a, 5)
For b = 2 To UBound(NewVArray)
voyage2 = NewVArray(b, 5)
If voyage2 <> Voyage Then
If voyage2 <> "" Then
For Each cell In NewVArray
voyage2 = rollsheet.Range("C:C")
Next
End If
End If
Next
Next
Here are snips of sample idea, highlighted are the rows that need to be found, and the voyage that changed is in orange. Third on Rolls would be the output of the macro.
Oldsheet:
Newsheet:
Rolls:
Untested, but this is how I'd do it. Just going from your screenshots. If your actual data looks different then you will need to make some adjustments.
Sub test()
Dim wb As Workbook, oldsht As Worksheet, newsht As Worksheet, rollsht As Worksheet
Dim c As Range, id, col, cDest As Range, copied As Boolean, m
Set wb = ThisWorkbook
Set oldsht = wb.Sheets("Insert Yesterday's Report Here")
Set newsht = wb.Sheets("Insert Today's Report Here")
Set rollsht = wb.Sheets("Rolls")
'next empty row on Rolls sheet
Set cDest = rollsht.Cells(Rows.Count, "A").End(xlUp).Offset(1)
'loop colA on new sheet
For Each c In newsht.Range("A2:A" & newsht.Cells(Rows.Count, "A").End(xlUp).row).Cells
id = c.Value 'identifier from Col A
If Len(id) > 0 Then
m = Application.Match(id, oldsht.Columns("A"), 0) 'check for exact match on old sheet
If Not IsError(m) Then
'got a match: check for updates in cols B to C
copied = False
For col = 2 To 3
If c.EntireRow.Cells(col).Value <> oldsht.Cells(m, col).Value Then
If Not copied Then 'already copied this row?
cDest.Resize(1, 3).Value = c.Resize(1, 3).Value 'copy changed row
Set cDest = cDest.Offset(1) ' next empy row
copied = True
End If
cDest.EntireRow.Cells(col).Interior.Color = vbRed 'flag updated value
End If
Next col
Else
cDest.Resize(1, 3).Value = c.Resize(1, 3).Value 'copy new row
Set cDest = cDest.Offset(1) ' next empy row
End If
End If
Next c
End Sub

How to delete the rows based in excel sheet using column values

I have excel with 5 different sheets.
sheet3 and sheet4 i want delete rows based on the single column cell value.
in sheet 3 i want to delete rows based on H column cell values if H2="#N/A" and H503="#N/A" then delete entire rows.
in sheet 4 i want to delete rows based on b column cell values if B2="320857876",B3="32085678",B4="12133435" the delete the entire rows where B column cell values starts with 302.
and i want to delete all Data from 'C' column
My excel sheet is like this
Using excel file
Sub Create()
Dim LastRow As Long
Dim i As Long
LastRow = Range("B10000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("B" & i) = "#N/A" Then
Range("B" & i).EntireRow.Delete
End If
Next
End Sub
You've got a few requirements there and your code is fairly light but regarding the #N/A part of it, you can't just test for that text using the value approach, which is the default property returned for a range object.
Sub Create()
Dim LastRow As Long, i As Long
LastRow = Range("B10000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("B" & i).Text = "#N/A" Then
Range("B" & i).EntireRow.Delete
End If
Next
End Sub
... you need to use .Text to get that to work, or, If IsError(Range("B" & i)) Then is another approach.
The rest of your requirements is just logic. The rest of your code is relatively sound so you just need to work through it.
I hope that helps.
Sub delete_rows()
Dim sheet As Worksheet, cell As Range
Count = 1
For Each sheet In ThisWorkbook.Worksheets
If Count = 3 Then
lastrow = sheet.Cells(sheet.Rows.Count, "H").End(xlUp).Row
Set Rng = sheet.Range("H1:H" & lastrow)
For i = Rng.Cells.Count To 1 Step -1
If Application.WorksheetFunction.IsNA(Rng(i).Value) Then
Rng(i).EntireRow.Delete
ElseIf Rng(i).Value = "#NA" Then
Rng(i).EntireRow.Delete
End If
Next
ElseIf Count = 4 Then
lastrow = sheet.Cells(sheet.Rows.Count, "B").End(xlUp).Row
Set Rng = sheet.Range("B1:B" & lastrow)
Debug.Print (Rng(4).Text)
If Rng(2).Value = "320857876" And Rng(3).Value = "32085678" And Rng(4).Value = "12133435" Then
For i = Rng.Cells.Count To 1 Step -1
If Left(Rng(i).Value, 3) = "302" Then
Rng(i).EntireRow.Delete
End If
Next
End If
lastrow = sheet.Cells(sheet.Rows.Count, "C").End(xlUp).Row
Set Rng = sheet.Range("C1:C" & lastrow)
For Each cell In Rng
cell.Value = ""
Next cell
End If
Count = Count + 1
Next
End Sub

How to write two IF statements for different ranges in a loop, VBA

I am working on an Excel document using VBA. This document contains a database with multiple columns, but for simplicity, let's say I have 2 columns:
Column C corresponds to names
Column F corresponds to numbers.
I'm trying to create a macro that checks all the numbers in column F (with a loop). If the number is above 100, then check the adjacent cell in column C. If the name corresponds to a condition (let's say corresponds to John or Tom), then add the value of the number in another sheet. If none of those apply, check the next cell.
My problem is that I can't find a way to define the cells in column C (Creating a variable/object to call the cells or calling directly the adjacent cell).
My code looks like this:
Sub Test1()
Dim rngnumbers, rngnames, MultipleRange As Range
Set rngnumbers = Sheet2.Range("F2:F999")
Set rngnames = Sheet2.Range("C2:C999")
Set MultipleRange = Union(rngnumbers, rngnames)
For Each numb In rngnumbers
If numb.Value >= 100 Then
If Sheet2.Range("C2") = "John" Or Sheet2.Range("C2") = "Tom" Then '''The problem here is that it only looks at the cell C2 and not the adjacent cell
Sheet1.Range("I999").End(xlUp).Offset(1, 0).Value = numb.Value
Else
End If
End If
Next numb
End Sub
I tried modifying the line:
'If Sheet2.Range("C2") = "John" Or Sheet2.Range("C2") = "Tom" Then'
to something like:
'newname.String = "John" '
But I can't find a way to define newname.
Another idea would be to increment the If statement for the names within the For loop.
Additional note:
I am also not using formulas directly within Excel as I don't want any blank cells or zeros when the if functions are False.
Does this solve your problem - referencing the relevant cell in column C? OFFSET provides a relative reference, in this case look 3 columns to the left of F.
Sub Test1()
Dim rngnumbers As Range, rngnames As Range, MultipleRange As Range, numb As Range
Set rngnumbers = Sheet2.Range("F2:F999")
Set rngnames = Sheet2.Range("C2:C999")
Set MultipleRange = Union(rngnumbers, rngnames)
For Each numb In rngnumbers
If numb.Value >= 100 Then
If numb.Offset(, -3) = "John" Or numb.Offset(, -3) = "Tom" Then
Sheet1.Range("I999").End(xlUp).Offset(1, 0).Value = numb.Value
End If
End If
Next numb
End Sub
Have you considered SUMIFS instead?
You want something like this?
Sub Test1()
Dim lRow As Long, r As Long
lRow = 1000 'last row in your data
Dim ws As Worksheet
Set ws = Worksheets("List with your data")
For i = 2 To lRow
If ws.Range("F" & i) > 100 Then
If ws.Range("C" & i).Value = "John" Or ws.Range("C" & i).Value = "Tom" Then
Worksheets("Another sheet sheet").Range("A" & r) = Range("C" & i).Value ' r - Row, where we want to enter uor text
r = r + 1 'if you want to put next name on the next row
End If
End If
Next
End Sub
Two Ifs in a Loop
Union Version
Option Explicit
Sub Test1()
Const cFirst As Integer = 2
Const cLast As Integer = 999
Const cCol1 As Variant = "F"
Const cCol2 As Variant = "C"
Const cCol3 As Variant = "I"
Dim i As Integer
Dim rngU As Range
With Sheet2
For i = cFirst To cLast
If IsNumeric(.Cells(i, cCol1)) And .Cells(i, cCol1) >= 100 Then
If .Cells(i, cCol2) = "John" _
Or .Cells(i, cCol2) = "Tom" Then
If Not rngU Is Nothing Then
Set rngU = Union(rngU, .Cells(i, cCol1))
Else
Set rngU = .Cells(i, cCol1)
End If
End If
End If
Next
End With
If Not rngU Is Nothing Then
rngU.Copy Sheet1.Cells(cLast, cCol3).End(xlUp).Offset(1, 0)
Set rngU = Nothing
End If
End Sub
I normally work with arrays:
Sub Test1()
Dim rngnumbers As Excel.Range
Dim arrVals As variant
Dim lngRow As long
Arrvals = Sheet2.Range("C2:F999").value
For Lngrow = lbound(arrvals,1) to ubound(arrvals,1)
If arrvals(lngrow,4) >= 100 Then
If arrvals(lngrow,1)= "John" Or arrvals(lngrow,1) = "Tom" Then '''The problem here is that it only looks at the cell C2 and not the adjacent cell
Sheet1.Range("I999").End(xlUp).Offset(1, 0).Value = arrvals(lngrow,4)
Else
End If
End If
Next lngrow
End Sub
Actually I would probably build an output array as well, but my thumb is tired...

Excel macro to replace cells content from a 2 columns lookup

In a worksheet, Sheet1, I need to go through column A and look for any value of Sheet2 col. A and replace the string found by Sheet2 col. B value.
For example if I have "go to http://google.com every day" somewhere in Sheet1.A and "google" in Sheet2.A234, I need to replace the original string by Sheet2.B234 value ("stackoverflow") to get "go to http://stackoverflow.com every day" into the original cell or in a new column.
No change if nothing is found.
I don't know much about vba, I only slightly modified some code found here and there. I know how to make a formula to do this but I can get any loop/range working in this case.
Any help appreciated :)
Fred
YowE3K works great, less elegant but working too:
Sub remplace()
Dim myInput As String, myTest As String, myReplacement As String
For i = 1 To 8 'for 10 rows of data in Sheet2
For j = 1 To 4 'for 5 rows of data in Sheet1
myInput = Sheets("Sheet3").Cells(j, 1).Value
myTest = Sheets("Sheet4").Cells(i, 1).Value
myReplacement = Sheets("Sheet4").Cells(i, 2).Value
resultText = Replace(myInput, myTest, myReplacement)
Sheets("Sheet3").Cells(j, 1).Value = resultText
Next j
Next i
End Sub
The following code should do what you want, but may not be terribly efficient if you have large numbers of rows in either Sheet1 or Sheet2. ("large" probably means > 1000)
Sub ReplaceValues
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rows1 As Long
Dim rows2 As Long
Dim row1 As Long
Dim row2 As Long
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
rows1 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
rows2 = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row
For row1 = 1 To rows1
For row2 = 1 To rows2
ws1.Cells(row1, 1).Value = Replace(ws1.Cells(row1, 1).Value, _
ws2.Cells(row2, 1).Value, _
ws2.Cells(row2, 2).Value)
Next
Next
End Sub
the below code will do the job
Sub foo()
For i = 1 To 10 'for 10 rows of data in Sheet2
For j = 1 To 5 'for 5 rows of data in Sheet1
If Sheets("Sheet2").Cells(i, 1).Value = Sheets("Sheet1").Cells(j, 1).Value Then
Sheets("Sheet1").Cells(j, 1).Value = Sheets("Sheet2").Cells(i, 2).Value
End If
Next j
Next i
End Sub

Delete specific rows using range function

I want to delete all rows in excel sheet if specific column value starts with 1.
For example, if range of A1:A having values starts with 1 then I want to delete all those rows using excel vba.
How to get it?
Dim c As Range
Dim SrchRng
Set SrchRng = Sheets("Output").UsedRange
Do
Set c = SrchRng.Find("For Men", LookIn:=xlValues)
If Not c Is Nothing Then c.EntireRow.Delete
Loop While Not c Is Nothing
Here's the required code with comments on how it works. Feed the worksheet and column number to the sub and call it e.g. Delete Rows 2, Sheets("myWorksheet"):
Sub DeleteRows(columnNumber as Integer, ws as WorkSheet)
Dim x as long, lastRow as Long
' get the last used row
lastRow = ws.cells(1000000, columnNumber).end(xlUp).Row
'loop backwards from the last row and delete applicable rows
For x = lastRow to 1 Step -1
' if the cell starts with a number...
If IsNumeric(Left(ws.Cells(x, columnNumber), 1) Then
'Delete it the row if it's equaal to 1
If Left(ws.Cells(x, columnNumber), 1) = 1 Then ws.Rows(x &":"& x).Delete
End If
Next x
End Sub
Dim Value As String
Dim CellName As String
Dim RowNumber As Long
Do While Value <> ""
CellName = "A" + RowNumber
Value = ActiveSheet.Cells(GetRowNumber(CellName), GetColumnNumber(CellName)).Value
If Mid(Value, 1, 1) = "2" Then
ActiveSheet.Range("A" & RowNumber).EntireRow.Delete
End If
RowNumber = RowNumber + 1
Loop
Private Function GetColumnNumber(ByVal CellName As String) As Long
For L = 1 To 26
If Left(CellName, 1) = Chr(L + 64) Then
GetColumnNumber = L
Exit For
End If
Next
End Function
Private Function GetRowNumber(ByVal CellName As String) As Long
GetRowNumber = CLng(Mid(CellName, 2))
End Function
You may be pushing the bounds of what is reasonable to do in Excel vba.
Consider importing the Excel file into Microsoft Access.
Then, you can write 2 Delete Queries and they will run uber fast:
DELETE FROM MyTable WHERE col1 like '2*'
DELETE FROM MyTable WHERE col2 LIKE '*for men*' OR col3 LIKE '*for men*'
After deleting those records, you can export the data to a new Excel file.
Also, you can write an Access Macro to import the Excel File, run the Delete Queries, and Export the data back to Excel.
And you can do all of this without writing a line of VBA Code.
You can try:
Sub delete()
tamano = Range("J2") ' Value into J2
ifrom = 7 ' where you want to delete
'Borramos las celdas
'Delete column A , B and C
For i = ifrom To tamano
Range("A" & i).Value = ""
Range("B" & i).Value = ""
Range("C" & i).Value = ""
Next i
End Sub

Resources