I have a cell (U4, for example) where I insert a value. I'll call it A, for example.
I want to copy all the values in Column K higher than A (starting in row 4), and place them in Column N (starting in row 4 also). Besides that, i want to copy the correspondent values in Column L and place them in column O.
Right now I have this, just for Column K:
A = Range("U4").Value
Cotacopy = 4
With Range("K4")
If .Cells(1, 1).Value > A Then
Range(.Cells(1, 1), .End(xlDown)).Copy Destination:=Sheets("Cálculo").Range("N" & Cotacopy)
x = x + 1
Else
End If
End With
I don't know if this is entirely correct, i'm adapting another process where i copy all the cells in one column that have value.
How about the following For loop:
Sub CopyHigherValue()
Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
y = 4
For x = 4 To lastrow
If Cells(x, 1).Value < Cells(x, 11).Value Then
Cells(y, 14).Value = Cells(x, 11).Value
Cells(y, 15).Value = Cells(x, 12).Value
y = y + 1
End If
Next x
End Sub
Related
Sub Formatted_Salary()
Dim lastrow, Total As Integer
lastrow = 0
Total = 0
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = lastrow To 1 Step -1
If Cells(i, 1) = "" Then
ActiveSheet.Rows(i).EntireRow.Delete
ElseIf Cells(i, 11).Value Then
Total = Total + Cell.Value (Problem Area)
End If
Next
newlastrow = Cells(Rows.Count, 1).End(xlUp).Row
Cells(newlastrow + 1, 10).Value = "Total Base Salary"
Cells(newlastrow + 1, 11).Value = Total
Cells(newlastrow + 1, 11).Font.Color = vbGreen
End Sub
The line of code label as problem area is not working, and I would like some help. (im new to all is this). Basically what I would like the code to do is to delete all the blank rows and then add the total value of a column K and the print value at desired location. Thanks. Any help is appreciated.
I have 3 sheets which name are Sheet1, Sheet2 and Sheet3. All sheets have the same columns. I have been using a SUMIFS formula in Sheet2.Range("C2"):
=SUMIFS(Sheet1!$C$2:$C$15,Sheet1!$B$2:$B$15,'Sheet2'!B2,
Sheet1!$A$2:$A$15,'Sheet2'!A2,Sheet1!$D$2:$D$15,"="&'Sheet2'!D2)-
SUMIFS(Sheet3!$C$2:$C$15,Sheet3!$B$2:$B$15,'Sheet2'!B2,
Sheet3!$A$2:$A$15,'Sheet2'!A2,Sheet3!$D$2:$D$15,"="&'Sheet2'!D2)
I have prepared below code which takes the value of Sheet1 Column C by matching Column A, B and D with Sheet2, and paste the result in Sheet2 Column C.
I have been looking for a way to to subtract the Sheet3 Column C quantity from Sheet1 Column C by matching Column A, B and D then its result should be pasted into Sheet2 Column C.
The file and data are attached here:
Dim dict As Object
Dim searchrange As Range
With Sheet1
Dim last_y As Long
Dim i As Long
Set dict = CreateObject("Scripting.Dictionary")
last_y = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To last_y
dict(.Cells(i, 1).Value & .Cells(i, 2).Value & .Cells(i, 4).Value) = _
dict(.Cells(i, 1).Value & .Cells(i, 2).Value & .Cells(i, 4).Value) + _
.Cells(i, 3).Value
Next i
End With
With Sheet3
last_y = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To last_y
.Cells(i, 3).Value = dict(.Cells(i, 1).Value & .Cells(i, 2).Value & _
.Cells(i, 4).Value)
Next i
End With
If all you need is a direct comparison then using a Dictionary is probably not the best method. I would just iterate through all 3 sheets as long as its under 100k rows. You could get fancy with .Find and .FindNext but the easiest is just a good old For Loop.
If I'm understanding your request, you need all values from Sheet 1 to be subtracted by a corresponding value from sheet 3 (if it exists) and then outputted into the matching row of sheet 2 (if it exists). Here's how I would do that:
Sub rowMatch()
Dim a As String, b As String, c As Double, d As String
For i = 2 To Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
'Grab the Sheet1 values
a = Sheet1.Cells(i, 1).Text
b = Sheet1.Cells(i, 2).Text
c = Sheet1.Cells(i, 3).Value
d = Sheet1.Cells(i, 4).Text
'Check Sheet3
For j = 2 To Sheet3.Cells(Sheet3.Rows.Count, 1).End(xlUp).Row
If Sheet3.Cells(j, 1).Text = a _
And Sheet3.Cells(j, 2).Text = b _
And Sheet3.Cells(j, 4).Text = d _
Then
c = c - Sheet3.Cells(j, 3).Value
End If
Next j
'Put into Sheet2
For k = 2 To Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row
If Sheet2.Cells(k, 1).Text = a _
And Sheet2.Cells(k, 2).Text = b _
And Sheet2.Cells(k, 4).Text = d _
Then
Sheet2.Cells(k, 3) = c
End If
Next k
Next i
End Sub
Edit: To further improve this, you may want to make the code more flexible by only comparing the strings after doing operations like UCASE() and TRIM(). And you may want to add in exceptions for if a, b, or d are blank. Maybe in those cases you want to allow partial matches. My example was just the basic idea.
I have two columns, Column A has a set of a few standard values and column B has all unique values. I'm only just experimenting with more complex ways of compiling data than the beginner level so I'm a bit at a loss.
I need to either have a lookup or create a macro that will list only the values in A (once each) but also display which values in B correspond to those in A
for example
A | B
va1|abc
va1|bcd
Va2|xyz
va3|zab
will show (in a single cell) the following
va1: abc, bcd
va2: xyz
va3: zab
Please help!
Option Explicit
Sub Test()
Dim i As Long, j As Long, k As Long
k = 1
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Application.CountIf(Range("C:C"), Cells(i, 1).Value) = 0 Then
Cells(k, 3).Value = Cells(i, 1).Value
For j = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(j, 1).Value = Cells(k, 3).Value And _
InStr(Cells(k, 4).Value, Cells(j, 2).Value) = 0 Then
If Cells(k, 4).Value = "" Then
Cells(k, 4).Value = Cells(j, 2).Value
Else
Cells(k, 4).Value = Cells(k, 4).Value & ", " & Cells(j, 2).Value
End If
End If
Next j
k = k + 1
End If
Next i
For i = 1 To Cells(Rows.Count, 3).End(xlUp).Row
Cells(i, 3).Value = Cells(i, 3).Value & ": " & Cells(i, 4).Value
Cells(i, 4).ClearContents
Next i
End Sub
Edited for single cell
In case your requirement is to "have the grouped data", and not exactly "have one single string per A", you can do this with a "pivot table" putting A and B in the row labels, like in the following picture:
I am looking for a VBA code for the below scenario:
There are four columns (A, B, C, D) in an excel sheet and the code should populate the D column.
The logic should be
IF C2 = A2, then populate D2 with value in B2
else if C2 = A3, then populate D2 with B3 and so on till D2 gets right value.
The columns are long lists with 400 entries.
Try this:
Sub MySub()
Dim lastRow As Long, i As Long
lastRow = Cells(Rows.Count, 3).End(xlUp).Row
For i = 2 To lastRow
If Cells(i, 1).Value = Cells(i, 3).Value Then
Cells(i, 4).Value = Cells(i, 2).Value
Else If Cells(i + 1, 1).Value = Cells(i, 3).Value Then
Cells(i, 4).Value = Cells(i + 1, 2).Value
End If
Next
End Sub
Sub test()
Dim x As Integer
Dim erow As Integer
'erow takes in the value of the last row number.
erow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For x = 1 To erow
For i = x To erow
If Cells(x, 3).Value = Cells(i, 1).Value Then
Cells(i, 2).Select
Application.CutCopyMode = False
Selection.Copy
Cells(x, 4).Select
ActiveSheet.Paste
Application.CutCopyMode = False
i = erow
End If
Next i
Next x
End Sub
Is this what you need. It does this for every D column not only for 2nd D column.
I'm trying to copy a cell and the adjacent cell in a row and insert it as a new row with all the data to the right of this cell also copied over. My data looks like this after mining.
and im trying to get my data to look like this:
the image above is just one record but essentially its moving all the people and their corresponding position in the original row to a new row. In each row there are about 5 employees and their positions.
thanks
EDIT Attempted code for just 2 cols. 1 position. the idea was to create the empty rows and just copy the rest of the data with auto fill, then work from there
Sub TransposeInsertRows()
Dim rng As Range
Dim i As Long, j As Long, k As Long
Dim x As Long, y As Long
Set rng = Application.InputBox _
(Prompt:="Range Selection...", _
Title:="Enter the name col and pos col", Type:=8)
Application.ScreenUpdating = False
x = rng(1, 1).Column + 2
y = rng(1, rng.Columns.Count).Column
For i = rng(rng.Rows.Count, 1).Row To rng(1, 1).Row Step -1
If Cells(i, x) <> "" And Cells(i, x + 1) <> "" Then
k = Cells(i, x - 2).End(xlToRight).Column
If k > y Then k = y
For j = k To x + 1 Step -1
Cells(i + 1, 1).EntireRow.Insert
With Cells(i + 1, x - 2)
.Value = .Offset(-1, 0)
.Offset(0, 1) = .Offset(-1, 1)
.Offset(0, 2) = Cells(i, j)
End With
Cells(i, j).ClearContents
Next j
End If
Next i
Application.ScreenUpdating = True
End Sub
If there are always 5 people in each row then this should do it:
Sub foo()
LastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow 'loop through rows
For x = 1 To 10 Step 2 'loop through columns
LastRow2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1 'find the next free row on Sheet2
Sheet2.Cells(LastRow2, 1).Value = Sheet1.Cells(i, x).Value 'add Person Name to Sheet2
Sheet2.Cells(LastRow2, 2).Value = Sheet1.Cells(i, x + 1).Value 'add position to Sheet2
Sheet1.Range("K" & i & ":U" & i).Copy Destination:=Sheet2.Cells(LastRow2, 3) 'copy range from K to U to Sheet2
Next x
Next i
End Sub