n this project i have to check column's A value between Column B and Column C. If columnA's values>= Columns B value or Columns A value<= Columns C value then i need to copy column d and e values and need to put into sheet1 column G and H. Column A is in sheet1 and Column B, C, D and E in sheet2.
A B C D E
1 1 9 Dog Naruto
11 10 19 Cat one piece
21 20 30 Duck lo
1
31
12
and so on
I want the outcome like this
A G H
1 Dog Naruto
11 cat One piece
21 duck o
1 Dog Naruto
31
12 cat One piece
and so on
This is the code I got with the help of someone but its limited. I want it to return value no matter how many rows A column has.
Dim i As Long
Dim lRow As Long
Dim colA As Double, colB As Double, colC As Double
lRow = Sheets("Sheet1").Range("A" &
Sheets("Sheet1").Rows.Count).End(xlUp).Row
For i = 2 To lRow
colA = Sheets("Sheet1").Range("A" & i).Value
colB = Sheets("Sheet2").Range("B" & i).Value
colC = Sheets("Sheet2").Range("C" & i).Value
If colA >= colB Or colA <= colC Then
Sheets("Sheet1").Range("G" & i).Value = Sheets("Sheet2").Range("D" &
i).Value
Sheets("Sheet1").Range("H" & i).Value = Sheets("Sheet2").Range("E" &
i).Value
End If
Next i
If column B in Sheet2 is in a ascending order …
… you can easily do that with a formula. In B2 add the following formula and pull it down and right.
=INDEX(Sheet2!D:D,MATCH($A:$A,Sheet2!$B:$B,1))
And you will get this output in Sheet1:
The same approach would be possible with VBA using Application.WorksheetFunction but I recommend to use the formula.
VBA Solution
Option Explicit
Public Sub FindAndFillData()
Dim wsDest As Worksheet
Set wsDest = ThisWorkbook.Worksheets("Sheet1")
Dim wsLookup As Worksheet
Set wsLookup = ThisWorkbook.Worksheets("Sheet2")
Dim LastRow As Long
LastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row
Dim MatchedRow As Double
Dim iRow As Long
For iRow = 2 To LastRow
MatchedRow = 0 'initialize!
On Error Resume Next
MatchedRow = Application.WorksheetFunction.Match(wsDest.Cells(iRow, "A").Value, wsLookup.Columns("B"), 1)
On Error GoTo 0
If MatchedRow <> 0 Then
If wsDest.Cells(iRow, "A").Value <= wsLookup.Cells(MatchedRow, "C").Value Then
wsDest.Cells(iRow, "B").Value = wsLookup.Cells(MatchedRow, "D").Value
wsDest.Cells(iRow, "C").Value = wsLookup.Cells(MatchedRow, "E").Value
End If
End If
Next iRow
End Sub
Related
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
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.
I have data in a column and I am trying to run a macro so that a new row (a preset line) is inserted every time a new value is found.
Here is an example of how the data looks currently:
1 C 100
1 D 100
1 E 100
1 F 100
1 G 100
2 C 200
2 D 200
2 E 200
I want the macro to look in the first column and if there is a new value then insert a row (paste a predefined line)
This is the outcome:
1 C 100
1 D 100
1 E 100
1 F 100
1 G 100
Predefined line copied
2 C 200
2 D 200
2 E 200
Predefined line copied
My current code looks like this. It is not working:
Sub InsertCreditorLine()
'based on value in column AB, works out where new expense starts and inserts the creditor line formula row
Dim Col As Variant
Dim BlankRows As Long
Dim LastRow As Long
Dim PrintArea1 As Variant
Dim R As Long
Dim StartRow As Long
' works out last row to work up from
Col = "AB"
StartRow = 6
BlankRows = 1
LastRow = Cells(Rows.Count, Col).End(xlUp).Row
Application.ScreenUpdating = False
With ActiveSheet
For R = LastRow To StartRow + 1 Step -1
'Looks to value in column AB to see where new expense starts
If .Cells(R, Col) = "Y" Then
'paste in line
Rows("1:13").Select
Selection.EntireRow.Hidden = False
.Cells(7, 7).EntireRow.Copy
.Cells(R, Col).EntireRow.Insert Shift:=xlDown
End If
Next R
End With
Application.CutCopyMode = False
How about this?
Sub InsertCreditorLine()
Dim startRow As Long, lastRow As Long, presetRow As Range, rw As Long
startRow = 6
lastRow = Range("AB" & Rows.Count).End(xlUp).Row
Set presetRow = Range("7:7")
For rw = lastRow To startRow + 1 Step -1
If Range("AB" & rw) <> Range("AB" & rw).Offset(-1, 0) Then
presetRow.Copy
Range("AB" & rw).Insert Shift:=xlDown
End If
Next rw
End Sub
I have fours lists in Excel of arbitraty lenght.
A B C D
A1 B1 C1 D1
A2 B2 C2 D2
A3 B3 D3
A4 D4
D5
I want to create one table that has every combination from the lists as rows.
A B C D
A1 B1 C1 D1
A1 B1 C1 D2
...
A4 B3 C2 D5
Is there any simple way to do this in Excel - using Excel functionality, formulas or VBA?
If you have your four lists next to each other, highlight the data and insert a pivot table.
Add each of the columns to the "rows" section of the pivot table.
Right-click on each field in turn and click on "Field Settings".
Set the Layout and print to show tabular form, repeated item labels and items with no data as follows.
And this is the resulting table.
I suspect you'll want to delete the rows which contain 1 or more (blank) rows.
This is probably easiest by adding a formula to column E along the lines of
=IF(A2="(blank)",1,0)
Repeat this for the other columns, Add them up and sort by the total.
Delete all rows that have a non-zero entry.
Some nested for statements should handle this problem. Just put this in the VBA for your project and it will create a macro called CreateTable() which should put the table in a new worksheet for you.
Sub CreateTable()
'Creates a table will all combinations of values from four columns
Dim a, b, c, d As Range
'Activates sheet that has data on it to be copied to table
Worksheets("Sheet1").Activate 'Change Sheet1 to the name of your sheet
'Change A2 to first cell of data you want to be copied over
Set a = Range("A2", Range("A2").End(xlDown))
Set b = Range("B2", Range("B2").End(xlDown))
Set c = Range("C2", Range("C2").End(xlDown))
Set d = Range("D2", Range("D2").End(xlDown))
Dim i As Integer
i = 1 'Row number of the first row of data for the table of combinations
Worksheets("Sheet2").Activate 'Change Sheet2 to name of sheet you want the table to be put on
For Each cellA In a.Cells
For Each cellB In b.Cells
For Each cellC In c.Cells
For Each cellD In d.Cells
Worksheets("Sheet2").Cells(i, 1) = cellA.Value
Worksheets("Sheet2").Cells(i, 2) = cellB.Value
Worksheets("Sheet2").Cells(i, 3) = cellC.Value
Worksheets("Sheet2").Cells(i, 4) = cellD.Value
i = i + 1
Next cellD
Next cellC
Next cellB
Next cellA
End Sub
You should show what you've tried already and give specifics of where your data is coming from, but here's a VBA solution. Loops through each item in a given column, for as many rows as there are total combinations of items.
Sub Combination_Table()
Dim rList1 As Range
Dim rList2 As Range
Dim rList3 As Range
Dim rList4 As Range
Dim lLength1 As Long
Dim lLength2 As Long
Dim lLength3 As Long
Dim lLength4 As Long
Dim lRowcounter As Long
Sheets(1).Activate
With Sheets(1)
lLength1 = .Range("A" & .Rows.Count).End(xlUp).Row - 1
lLength2 = .Range("B" & .Rows.Count).End(xlUp).Row - 1
lLength3 = .Range("C" & .Rows.Count).End(xlUp).Row - 1
lLength4 = .Range("D" & .Rows.Count).End(xlUp).Row - 1
Set rList1 = .Range("A2:A" & lLength1)
Set rList2 = .Range("B2:B" & lLength2)
Set rList3 = .Range("C2:C" & lLength3)
Set rList4 = .Range("D2:D" & lLength4)
End With
'The above marks the ranges containing the original un-combined lists,
'with no duplicates and assuming row 1 is the header and all data is on
'columns A-D, without blanks.
rowcounter = 0
Sheets(2).Activate
For i = 1 To lLength1
For j = 1 To lLength2
For k = 1 To lLength3
For l = 1 To lLength4
rowcounter = rowcounter + 1
Sheets(2).Range("A" & rowcounter).Formula = rList1(i, 1).Text
Sheets(2).Range("B" & rowcounter).Formula = rList2(j, 1).Text
Sheets(2).Range("C" & rowcounter).Formula = rList3(k, 1).Text
Sheets(2).Range("D" & rowcounter).Formula = rList4(l, 1).Text
'This changes the text in columns A-D for the given rowcount, to the current
'iteration of the current looped value from the above lists
Next l
Next k
Next j
Next i
End Sub
This Works too and this is simpler.
Sub t()
Dim sht As Worksheet
Dim LastRow As Long, lastcol As Long
Dim i As Integer, j As Integer, k As Integer
Set sht = ThisWorkbook.Sheets("Sheet1")
LastRow = sht.Range("A1").CurrentRegion.Rows.Count
lastcol = sht.Range("A1").CurrentRegion.Columns.Count
k = 0
For i = 2 To LastRow
j = 1
k = k + 1
For j = 1 To lastcol
sht.Cells(i, j).Value = sht.Cells(1, j) & k
Next
Next
End Sub
Hi guys I am running a macro in Excel 2003 to match property addresses to their owners addresses so I end up with a report of absentee owners.
So in:
column A column C
10 Smith DR Smithville 10 Smith DVE, Smithfield, 49089 Antartica
This is how some of the raw data has been input but I need for this record and all the other slightly different records to be a match and therefore not selected by the macro
as it searches for absentee owners addresses then populates the selected records to sheet2.
In laymans terms if I could compare say only the first 6 characters in column A to the first 6 characters in column C then I think it would work the way I need it to.
Does anyone know how I can achieve this within my macro shown below
Sub test()
Dim i As Long, lr As Long, r As Long, ws As Worksheet, value As Variant,
val As Variant
Dim sval As Integer, lr2 As Long
Application.ScreenUpdating = False
Set ws = Worksheets("Sheet1")
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lr
value = Split(Cells(i, 1).value, ", ")
For val = LBound(value) To UBound(value)
sval = InStr(1, Cells(i, 3).value, value(val), 1)
If sval = 0 Then Range("A" & i & ":" & "C" & i).Interior.Color = 65535
Next
Next
For r = 2 To lr
lr2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
If Range("A" & r).Interior.Color = 65535 Then
Rows(r).Copy Destination:=Sheets("Sheet2").Rows(lr2 + 1)
lr2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
End If
Next r
Sheets("Sheet2").Cells.Interior.ColorIndex = 0
Application.ScreenUpdating = True
MsgBox "Done Macro"
End Sub
Hopefully I have pasted the code in the correct format required here.
So any help and guidance would be much appreciated.
You can use the formula LEFT(). This will check the first 6 characters from the cell in column A to the first 6 characters in column C. If there's a match, it will add the value from column A to the next free cell in column A, Sheet2.
Sub First6Characters()
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastRowSheet2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
If Left(Range("A" & i), 6) = Left(Range("C" & i), 6) Then
Sheets("Sheet2").Range("A" & LastRowSheet2).Value = Range("A" & i).Value
LastRowSheet2 = LastRowSheet2 + 1
End If
Next i
End Sub
Source: http://www.techonthenet.com/excel/formulas/left.php