i have problem with my VBA app. At the ssheet1 i have names in format Curry,Steph and every name is having an id. At changedNames i have the same names but in other format which is Steph Curry again with optional id which is the same as Curry,Steph. How can i make the names that i enter like Curry,Steph to change to the other type Steph Curry and to be with the same id. Also when i do the removeDuplicates method, its removing a digit from the id but the thing i want its to delete the row. Thanks in advance!
Sub GenerateNames()
Dim ssheet1 As Worksheet
Dim rngen As Worksheet
Dim rnsheet As Worksheet
Dim changedNames As Worksheet
Set ssheet1 = ThisWorkbook.Sheets("Sheet1")
Set rngen = ThisWorkbook.Sheets("RnGen")
Set rnsheet = ThisWorkbook.Sheets("RandomNames")
Set changedNames = ThisWorkbook.Sheets("ChangedNames")
rngen.Range("A3:A70").Copy rnsheet.Range("A3:A70")
ssheet1.Range("B3:B70").Copy rnsheet.Range("B3:B70")
For b = 1 To 70
For c = b + 1 To 70
If Cells(b, 2).Value = Cells(c, 2).Value Then
Cells.RemoveDuplicates
End If
Next c
Next b
End Sub
You could try something like this:
Not tested:
For b = 70 To 1 step (-1)
For c = 70 to b + 1 step (-1)
If Cells(b, 2).Value = Cells(c, 2).Value Then
Cells(c,2).row.delete
End If
Next c
Next b
Related
I have a gigantic table in excel(720x720) in which I want to find non-zero values. when the value is found I would like to get the first two cells of this row on a new sheet on two columns, the cell in question on a third and the first two cells in the columns of the cell I'm looking for on two other columns.
For example if my values are in E26 R89 and Z9 on sheet 1 I would like to get a table on sheet 2 that would look like this:
A B C D E
1 A26 B26 E26 E1 E2
2 A89 B89 R89 R1 R2
3 A9 B9 Z9 Z1 Z2
Here is what I've tried so far (please bear in mind that you are talking to a beginner)
Sub tests_selection()
Dim r As Worksheet
Dim c As Workbook, f As Worksheet
Set c = Workbooks("classeur1")
Set f = c.Worksheets("feuil1")
Dim a(5200)
Dim b
b = 0
Range("A1:AAU723").Select
For i = 4 To 720
For j = 4 To 723
If f.Cells(i, j).Value <> 0 Then
a(b) = f.Cells(i, j).Adress
b = b + 1
End If
Next j
Next i
Set r = c.Worksheets("result")
For i = 0 To b
r.Cells(i, 1).Value = a(i)
Next i
End Sub
Table example
Result example
First of all you should use meaningful variable names instead of 1 character only. This makes your code much more understandable and readable and therefore results in less bugs.
Also use Option Explicit to force proper variable declaring.
Option Explicit
Sub tests_selection()
Dim SrcWs As Worksheet
Set SrcWs = Worksheets("feuil1") 'source worksheet
Dim ResultWs As Worksheet
Set ResultWs = Worksheets("result") 'result worksheet
Dim rRow As Long
rRow = 2 'start row in result sheet
Dim iCell As Range
For Each iCell In SrcWs.Range("C4:AN40") '<-- make sure to adjust the range to the data only! so header rows are not included
If iCell.Value <> 0 Then
ResultWs.Cells(rRow, 1).Value = SrcWs.Cells(iCell.Row, 1).Value
ResultWs.Cells(rRow, 2).Value = SrcWs.Cells(iCell.Row, 2).Value
ResultWs.Cells(rRow, 3).Value = iCell.Value
ResultWs.Cells(rRow, 4).Value = SrcWs.Cells(1, iCell.Column).Value
ResultWs.Cells(rRow, 5).Value = SrcWs.Cells(2, iCell.Column).Value
rRow = rRow + 1
End If
Next iCell
End Sub
I have a excel sheet looks like this: "Sheet1" & "Sheet2" and I wanted the result as shown in "Sheet3".
Sample Data
Eventually I would like to put a "Button" in a separate sheet (Control Panel) and when clicking on it I need to combine the data from "Sheet1" and "Sheet2" with the transpose effect as shown in "Sheet3".
How can I automate this using macro since there are ~2000 "rows" in Sheet 1 and ~1000 in Sheet 2. I'm new to macro so hopefully I can make this automated otherwise I'm copying and pasting all of them manually.
Thanks!
It might be helpful to use a function that returns the last row of a worksheet:
Public Function funcLastRow(shtTarget As Worksheet, Optional iColLimit As Integer = -1) As Long
If iColLimit = -1 Then
iColLimit = 256
End If
Dim rowMaxIndex As Long
rowMaxIndex = 0
Dim ctrCols As Integer
For ctrCols = 1 To iColLimit
If shtTarget.Cells(1048576, ctrCols).End(xlUp).Row > rowMaxIndex Then
rowMaxIndex = shtTarget.Cells(1048576, ctrCols).End(xlUp).Row
End If
Next ctrCols
funcLastRow = rowMaxIndex
End Function
You could use it simply like so:
Dim lLastRow As Long
lLastRow = funcLastRow(Sheets(1))
Please let us know if that worked for you thanks
Here is an all formula solution (No Macro)
Data is in Sheet1 A to I and Sheet2 A to G
I am assuming you have only 6 departments. although if you have additional, the formulas need very little or may be no modification.
In Sheet 3
Get the userID repeated six times
A2 = INDEX(Sheet1!A:A,1+QUOTIENT(ROW()-ROW($A$2)+6,6))
Get Name, Gender & Country
B2 = VLOOKUP($A2,Sheet1!$A$2:$I$3000,COLUMNS($A$1:B$1),FALSE)
C2 = VLOOKUP($A2,Sheet1!$A$2:$I$3000,COLUMNS($A$1:C$1),FALSE)
D2 = VLOOKUP($A2,Sheet1!$A$2:$I$3000,COLUMNS($A$1:D$1),FALSE)
Get Access to department. The "" & ... is to avoid 0 in case the resulting cell was blank.
E2 = "" & IF(SUMPRODUCT(--(Sheet1!$A$1:$I$1=F2))>0,HLOOKUP(F2,Sheet1!$A$1:$I$3000,MATCH(A2,Sheet1!$A$1:$A$3000,0),FALSE),HLOOKUP(F2,Sheet2!$A$1:$G$3000,MATCH(A2,Sheet2!$A$1:$A$3000,0),FALSE))
F2:F7 the departments are Input manually (no formula). F8 is linked to F2 so that the depts repeat when dragged down
G2 = "" & IF(SUMPRODUCT(--(Sheet1!$A$1:$I$1=F2))>0,INDEX(Sheet1!$I$1:$I$3000,MATCH(A2,Sheet1!$A$1:$A$3000,0)),INDEX(Sheet2!$G$1:$G$3000,MATCH(A2,Sheet1!$A$1:$A$3000,0)))
If you need, I can prepare a google sheet to demo. Cheers.
This code works very well for Transpose and concatenate of big data.
Sub ConcatData()
Dim X As Double
Dim DataArray(5000, 2) As Variant
Dim NbrFound As Double
Dim Y As Double
Dim Found As Integer
Dim NewWks As Worksheet
Cells(1, 1).Select
Let X = ActiveCell.Row
Do While True
If Len(Cells(X, 1).Value) = Empty Then
Exit Do
End If
If NbrFound = 0 Then
NbrFound = 1
DataArray(1, 1) = Cells(X, 1)
DataArray(1, 2) = Cells(X, 2)
Else
For Y = 1 To NbrFound
Found = 0
If DataArray(Y, 1) = Cells(X, 1).Value Then
DataArray(Y, 2) = DataArray(Y, 2) & ", " & Cells(X, 2)
Found = 1
Exit For
End If
Next
If Found = 0 Then
NbrFound = NbrFound + 1
DataArray(NbrFound, 1) = Cells(X, 1).Value
DataArray(NbrFound, 2) = Cells(X, 2).Value
End If
End If
X = X + 1
Loop
Set NewWks = Worksheets.Add
NewWks.Name = "SummarizedData"
Cells(1, 1).Value = "Names"
Cells(1, 2).Value = "Results"
X = 2
For Y = 1 To NbrFound
Cells(X, 1).Value = DataArray(Y, 1)
Cells(X, 2).Value = DataArray(Y, 2)
X = X + 1
Next
Beep
MsgBox ("Summary is done!")
End Sub
I've what seems like a pretty simple application with looping and 'If..Then' statements but need some help on structuring it.
In very a basic example, I have a list numbers in column A and the values PM or AM listed in column B. I want to write a loop that will search every value in column B until the end of the data set, and add 12 to each value in column A each time column B has a value of PM. In a nutshell, it would look like this:
If column B = PM
then add 12 to its corresponding cell in column A
else move down to the next row and do the same thing until you reach an empty cell
There are many ways, here is a typical one:
Sub dural()
Dim i As Long
i = 1
Do While Cells(i, "B").Value <> ""
If Cells(i, "B").Value = "PM" Then
Cells(i, "A").Value = Cells(i, "A").Value + 12
End If
i = i + 1
Loop
End Sub
you can set it with For next loop and 2 variables. one for last row and the 2nd for the row count:
Sub Macro1()
Dim LastRow As String
Dim i As Integer
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
If Cells(i, 2).Value = "PM" Then Cells(i, 1).vlaue = Cells(i, 1).vlaue + 10
Next i
End
'
End Sub
This is another way to do this.
Option Explicit
Sub Add()
Dim rData As Range
Dim r As Range
Set rData = Cells(1, 1).CurrentRegion.Columns("B").Cells
For Each r In rData
If UCase$(r.Value) = "PM" Then
r.Offset(, -1).Value = r.Offset(, -1).Value + 12
End If
Next r
End Sub
In the following code I have declared c to be used, but it seems as though it only works with numbers. I am looking for a string to compare with another string in another table on the same sheet.
The catch that makes this tricky is that I would like to offset the value to the cell adjacent to the left, and then compare one date with another. To make it more clear, my data is formatted like this: (Call it SetA)
A B C D E F G H I
CreateTime LotID AnalysisSet Slot# X Y ResultType TermName ResultName
A few more columns to the right.... Lets call this SetB
Y Z AA AB AC AD AE AF AG
CreateTime LotID AnalysisSet Slot# X Y ResultType TermName ResultName
Here is the code:
Sub AIM36DBOCompare()
Dim n As Integer
n = 2
Dim PasteCount As Integer
Dim test1 As Long
Dim test2 As Long
PasteCount = 41
Range("AD2:AD1000").Copy Destination:=Range("S41" & Lastrow)
Do While n <= 1000
If Cells(26, n) <> 0 Then
'--------------------------------------------
With Worksheets(1).Range("b2:b10000")
Set c = .Find(Cells(n, 26).String, LookIn:=xlValues)
If Not c Is Nothing Then
Do
test1 = Cells(n, 25).Value
test2 = c.Offset(0, -1)
If Abs(Cells(n, 25) - c.Offset(0, -1)) <= 100 Then
c.Offset(0, -1).Copy
Cells(PasteCount, 17).Select
Selection.Paste
PasteCount = PasteCount + 1
Exit Do
End If
Set c = .Find(Cells(n, 26).Value, LookIn:=xlValues)
Loop While Not c Is Nothing
End If
End With
'--------------------------------------------
End If
If Cells(11, n) = 0 Then
Exit Do
End If
n = n + 1
Loop
End Sub
So to be more clear here is the code: Find LotID in SetB, find the first (of multiple) corresponding LotID in SetA. Compare date in SetB to the date in SetA by offsetting the variable by one cell and then subtracting the two (using absolute value).
If it is under 100 days, then do stuff!
Its not doing stuff :(. The date in SetA is showing up as nothing. I think it is because of the variable being used. Please help!
The code fails at Test2 (and consequently) in the "if test" If Abs(Cells(n, 25) - c.Offset(-1, 0)) <= 100 Then
You mentioned that you want to take the cell to the left of c. In the code, you are getting the value from the cell above. To see this, try the code below:
Sub test()
Dim add As String
Dim c As Range
Dim offsetRange As Range
Set c = Range("B2")
Set offsetRange = c.Offset(-1, 0)
add = offsetRange.Address
Debug.Print add
Debug.Print offsetRange.Value
End Sub
Offset takes rows first, then columns, so you would want to swap to 0 and -1, as below:
Sub test2()
Dim add As String
Dim c As Range
Dim offsetRange As Range
Set c = Range("B2")
Set offsetRange = c.Offset(0, -1)
add = offsetRange.Address
Debug.Print add
Debug.Print offsetRange.Value
End Sub
Also, you are declaring and getting the values for the variables test1 and test2, but you are not using these values when doing the comparison.
In my Excel worksheet I have something like this:
1 2 3
John Paul Mike
1 John 0 1 1
2 Paul 1 0
3 Mike 1 0
Which is similar to a symmetric matrix. Note that:
Each person has an ID;
For simplification, I set the values to 1's, but they can go from 1
to 20. 0's will always be 0's. There are also some blank spaces.
What I need is a macro that goes through the "matrix" and outputs the values into another worksheet in the following format:
From To Strenght
1 2 1
1 3 1
2 1 1
3 1 1
This is what I have so far, but isn't working because it return the error "The object is required", pointing to strenghts.
Dim i As Integer, j As Integer, strenghts As Integer
Set currentCell = Worksheets("Raw_Relationships").Cells(3, 3)
For i = 1 To 145
For j = 1 To 145
If currentCell <> "" Then
Set currentCell = Worksheets("Raw_Relationships").Cells(i, j).Offset(2, 3)
Set strenghts = Worksheets("Raw_Relationships").Cells(i, j).Offset(2, 2).Value
Set Worksheets("Gephi_Data").Cells(i, 1).Offset(150, 0).Value = i
Set Worksheets("Gephi_Data").Cells(i, 2).Offset(150, 0).Value = j
Set Worksheets("Gephi_Data").Cells(i, 3).Offset(150, 0).Value = strenghts
End If
Next j
Next i
Any tips on how to do this?
There are many ways to achieve what you want. Here is a very basic example of what you want.
Let's say your sheet looks like this
Use this code. I have commented the code so that you shouldn't have a problem understanding it. If you do then simply ask :)
Code
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim i As Long, j As Long
Dim rw As Long, col As Long
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
'~~> This is where the output will be generated
rw = 2: col = 8
With ws
'~~> Create Headers of Output
.Cells(1, col).Value = "From"
.Cells(1, col + 1).Value = "To"
.Cells(1, col + 2).Value = "Strength"
'~~> Looping through rows
For i = 3 To 5
'~~> Looping through columns
For j = 3 To 5
'~~> Check if the cell is > 0
If .Cells(i, j).Value > 0 Then
'~~> Write the `From` column
.Cells(rw, col).Value = .Cells(i, 1).Value
'~~> Write the `To` Column
.Cells(rw, col + 1).Value = .Cells(1, j).Value
'~~> Write the `Strength` Column
.Cells(rw, col + 2).Value = .Cells(i, j).Value
rw = rw + 1
End If
Next j
Next i
End With
End Sub
Output
I am generating the output in Col H onwards. Change as applicable.
Get rid of Set in Set strenghts = .... Just write strenghts = .... Set is only used to set references to objects. strenghts isn't an object, it's a numeric value.
Also, I'm not sure if the typo in strenghts is intentional, but it's usually spelled "strengths".