I have columns in my csv like this:
Id Name Price
1 Level X discontinued 34
3 Level Y Dicontinued 64
7 Level Z 94
I want to check if in column Name are discontinued or Dicontinued
If yes delete row, if not, dont do nothing, so my final result will be:
Id Name Price
7 Level Z 94
A solution can be running the following Excel Macro ExampleMacro with the following setup. This code will filter the first worksheet [here TotalList] copying the content in a second worksheet [here Filtered]
NOTE: please use the same names I used or change the code of the following macro accordingly if you prefer to change the names. Otherwise it will not work
Sub ExampleMacro()
Dim i As Integer
Dim j As Integer
Set ShMaster = ThisWorkbook.Sheets("TotalList")
Set ShSlave = ThisWorkbook.Sheets("Filtered")
'cleanup for next macro executions
ShSlave.UsedRange.Clear
'copying the headers
ShSlave.Range("A1").Value = ShMaster.Range("A1").Value
ShSlave.Range("B1").Value = ShMaster.Range("B1").Value
ShSlave.Range("C1").Value = ShMaster.Range("C1").Value
'searching what to keep
j = 2
For i = 2 To ShMaster.UsedRange.Rows.Count
'MsgBox "value is " & InStr(1, (Range("B" & i).Value), "discontinued")
If InStr(1, (ShMaster.Range("B" & i).Value), "discontinued") = 0 Then
While ShSlave.Range("C" & j).Value <> ""
j = j + 1
Wend
ShSlave.Range("A" & j).Value = ShMaster.Range("A" & i).Value
ShSlave.Range("B" & j).Value = ShMaster.Range("B" & i).Value
ShSlave.Range("C" & j).Value = ShMaster.Range("C" & i).Value
End If
Next i
End Sub
Related
I'm trying to create a single file by consolidating 4 excel files into 1.
here is the code for the same
Public Sub CommandButton1_Click()
Dim wb As Workbook
Dim row As Long
Dim i As Long
Dim currow As Long
Dim LastRow As Long
LastRow = Sheets("Sheet1").Cells(65536, 2).End(xlUp).row
Columns("O:O").Insert
Range("O1").Value = "Source"
For i = 1 To 4 Step 1
Sheets("Sheet1").Range("O2:O" & LastRow).Value = "Dump" & i
Set wb = Workbooks.Open("C:\Users\BV\Desktop\Excel" & "\Dump" & i & ".xlsx")
With wb.Sheets("Data")
If i = 1 Then
row = 1
Else
row = 2
End If
Do Until .Range("A" & row).Value = vbNullString
currow = currow + 1
For n = 0 To 13 Step 1
Me.Range("A" & currow).Offset(columnoffset:=n).Value = .Range("A" & row).Offset(columnoffset:=n).Value
Next n
row = row + 1
Loop
End With
wb.Close True
Next i
Fees_check
Set wb = Nothing
End Sub
Dump1,Dump2,Dump3 and Dump4 are the source file names.
I want to add another column which gives the source file name after consolidating like Dump1,Dump2 etc.
Right now im getting the value as Dump4 for all the rows.
Any help is appreciated.
Thanks
Your problem is this line:
Sheets("Sheet1").Range("O2:O" & LastRow).Value = "Dump" & i
Every time you go through the loop you just replace values from "O2" to the last row with dump & i which, on the final time, just fills the whole column with "dump4"
So, get rid of that line and use your CurrRow variable to populate column "O" instead, maybe by just inserting a line in the bit that actually moves across the data, like this:
For n = 0 To 13 Step 1
Me.Range("A" & currow).Offset(columnoffset:=n).Value = .Range("A" & row).Offset(columnoffset:=n).Value
Me.Range("O" & currow).Value2 = "Dump" & i ' INSERT THIS LINE
Next n
This is a quick fix, I'd normally fill a range in one go but I think you're just dealing with small amounts of data it should be fine.
The group column in my table contains a value as either 1 or 2 . I want to copy the row with value as 1 to Sheet2 and rows with values as 2 to sheet3 using a button. Also it should show error message if cells are left blank or if value is neither 1 nor 2.
Roll no meter width group
112 150 130 1
Since i am new to coding i have following this approach
check if the cell is empty and generate an error message
check if the cell contains value other than 1 or 2 and generate error message
finally copy the row with values as 1 to Sheet2 and rest all in sheet3
I need help in doing this is an effective way. As i have to keep the size of file down
enter code here
Private Sub CommandButton2_Click()
Dim i As Integer
p = Sheet1.Range("l1").Value 'no. of filled cells in the range
Application.DisplayAlerts = False
Sheet1.Activate
''checking if the range is empty
For i = 29 To p + 29
If Sheet1.Range("l" & i).Value = "" Then
MsgBox ("PLEASE ENTER THE SHRINKAGE GROUP FOR CELL NO. l" & i)
Range("L" & i).Activate
End
End If
Next i
'' checking if the range contains values other than 1 or 2
For i = 29 To p + 29
If Sheet1.Range("l" & i).Value <> 1 And Sheet1.Range("l" & i).Value <> 2 Then
MsgBox ("SHADE GROUP DOES NOT EXIST FOR CELL NO. l" & i)
Range("L" & i).Activate
End
End If
Next i
' sort based on the group
Range("a29:L300").Sort _
Key1:=Range("l29"), Header:=xlYes
'count the number of rolls in group 1
Dim x, y As Long
Dim a, b As Integer
x = Range("L" & Rows.Count).End(xlUp).Row
If x < 29 Then x = 29
a = Application.WorksheetFunction.CountIf(Range("L12:L" & x), 1) + 28
Range("M1").Value = a
' count the number of rolls in group 2
y = Range("L" & Rows.Count).End(xlUp).Row
If y < 29 Then y = 29
b = Application.WorksheetFunction.CountIf(Range("L12:L" & x), 2)
Range("n1").Value = b
'' copying groupwise to different sheet
Sheet1.Range("a29", "l" & a).Copy
Sheet2.Range("a5").PasteSpecial xlPasteAll
Sheet2.Range("a5").PasteSpecial xlPasteValuesAndNumberFormats
'' copying group 2
Sheet1.Range("a" & a + 1, "l" & a + b).Copy
Sheet5.Range("a5").PasteSpecial xlPasteAll
Sheet5.Range("a5").PasteSpecial xlPasteValuesAndNumberFormats
End Sub
Create named ranges for your source data and for the rows after which you want it to be copied. In this example I've used "source", "range1" and "range2". Then the following code copies the source data into the appropriate place:
Sub copyData()
Dim source As Range, range1 As Range, range2 As Range
Dim r As Range
Set source = Range("source")
Set range1 = Range("range1")
Set range2 = Range("range2")
For Each r In source.Rows
If r.Cells(1, 4).Value = 1 Then
copyRow r, range1
ElseIf r.Cells(1, 4).Value = 2 Then
copyRow r, range2
Else
' handle error here
End If
Next r
End Sub
Sub copyRow(data As Range, targetRange As Range)
Set targetRange = targetRange.Resize(targetRange.Rows.Count + 1, targetRange.Columns.Count)
For i = 1 To 3
targetRange.Cells(targetRange.Rows.Count, i).Value = data.Cells(1, i).Value
Next i
End Sub
There's probably a much more elegant way of doing this involving array formulae, but this should do the trick.
For validating that each cell contains only "1" or "2", you can include additional code where I've put a comment, but you'd be better off handling this as a data validation.
I'm trying to write an if function into a save button on a user-form so that if the data entered into the user-form is already on sheet 2 then it only gets written to sheet 1. But if it does not exist on sheet 2 then the data from the user-form gets written to both sheet 1 and sheet 2. This is because I want the data on sheet 2 to act like a sort of database and obviously do not want duplicates. I've made the write procedures into two separate modules (I figured this would make it easier to differentiate). Here is my code (Be gentle I'm still learning)
Sub writetosheet1()
Dim i As Integer
i = 1
While ThisWorkbook.Worksheets("Sheet1").Range("A" & i).Value <> ""
i = i + 1
Wend
ThisWorkbook.Worksheets("Sheet1").Range("a" & i).Value = UserForm1.txt1.Value
ThisWorkbook.Worksheets("Sheet1").Range("b" & i).Value = UserForm1.txt2.Value
ThisWorkbook.Worksheets("Sheet1").Range("c" & i).Value = UserForm1.txt3.Value
ThisWorkbook.Worksheets("Sheet1").Range("d" & i).Value = UserForm1.txt4.Value
ThisWorkbook.Worksheets("Sheet1").Range("e" & i).Value = UserForm1.txt5.Value
End Sub
Sub writetosheet2()
Dim i As Integer
i = 1
While ThisWorkbook.Worksheets("Sheet1").Range("A" & i).Value <> ""
i = i + 1
Wend
ThisWorkbook.Worksheets("Sheet2").Range("a" & i).Value = UserForm1.txt1.Value
ThisWorkbook.Worksheets("Sheet2").Range("b" & i).Value = UserForm1.txt2.Value
ThisWorkbook.Worksheets("Sheet2").Range("c" & i).Value = UserForm1.txt4.Value
ThisWorkbook.Worksheets("Sheet2").Range("d" & i).Value = UserForm1.txt5.Value
End Sub
Private Sub CMDSAVE_Click()
Dim id As Long
id = txt1.Value
If id <> Sheets("Sheet2").Range("a:a").Value Then
Call writetosheet1
Call writetosheet2
Else
Call writetosheet1
End If
End Sub
Any help on this would be fantastic! Thanks.
I think that you can not compare one single value with whole range like this:
If id <> Sheets("Sheet2").Range("a:a").Value Then
You need to go trough all cells in that range separately.
If Application.CountIf(Sheet2.Range("A:A"), id) > 0 then
'write only to sheet1
else
'write to both sheets
end if
I have simple problem, but I am not able to find a "fix" for it.
I have the following code:
cmdSQLData.CommandText = Query 'some select
cmdSQLData.CommandType = adCmdText
cmdSQLData.CommandTimeout = 0
Set rs = cmdSQLData.Execute()
j = 1
x = 6 'the line I want the data to start
rs.MoveFirst
Do Until rs.EOF
Sheet1.Range("A" & x).Value = rs![name1]
Sheet1.Range("B" & x).Value = rs![name2]
Sheet1.Range("C" & x).Value = rs![name3]
Sheet1.Range("D" & x).Value = rs![name4]
.
.'lot more columns
.
Sheet1.Range("AC" & x).Value = rs![name28]
If x = 10 Then 'after each 10 lines to create another sheet
x = 6
j = j + 1
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name ="Sheet" & j
End If
Loop
cn.Close
Set cn = Nothing
Set rs = Nothing
Set cmdSQLData = Nothing
I need that when there are more "lines" in the record set than lets say 10, to have another sheet created, Sheet2, where to have the next 10 lines inserted and if the record set still has values to have another sheet created, Sheet3 and so on, until the record set has been fully parsed.
The problem is that for getting the data from record set to excel, i use Sheet1, hardcoded. I tryed to use instead of Sheet1, Sheet[j] or Sheet(j) and to increment "j" each time I create a new sheet, but I get an error, therefore I cannot use Sheet[j].Range("A" & x).Value=rs![name1] or Sheet(j).Range("A" & x).Value=rs![name1].
Any hints?
While I personally believe that collecting all data into one sheet before dividing them into set of x rows is much better, there's another way of going about it using your code. Instead of using Sheet1, use Sheets(j) where j is the sheet index. Also, you can do Sheets("Sheet" & j) as well.
Using the second approach, replace the respective block of your code with the following:
Set rs = cmdSQLData.Execute()
j = 1
x = 6 'the line I want the data to start
rs.MoveFirst
Do Until rs.EOF
With Sheets("Sheet" & j)
.Range("A" & x).Value = rs![name1]
.Range("B" & x).Value = rs![name2]
.Range("C" & x).Value = rs![name3]
.Range("D" & x).Value = rs![name4]
.
.'lot more columns
.
.Range("AC" & x).Value = rs![name28]
End With
x = x + 1
If x = 16 Then 'after each 10 lines to create another sheet
x = 6
j = j + 1
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Sheet" & j
End If
Loop
You also forgot to increment your x so it will keep on overwriting row 6 again and again. Here, you should be targeting x=10 but x=16 since you start from row 6 based on the initial value of x. The ten rows including row 6 ends in row 15. Once x is equal to 16, it should trigger your IF block.
I have corrected that for you in the above code. Let us know if this helps.
Try this for adding new sheet:
Do Until rs.EOF
If x = 10 Then
Set ws = Thisworkbook.Sheets.Add(After:=Thisworkbook.Sheets(Thisworksheet.Sheets.Count)
ws.Name = "Sheet" & j
x = 6
j = j + 1 ' although you don't really need this, sheet number increment automatically.
End If
ws.Range("A" & x).Value = rs![name1]
.
.
x = x + 1
Loop
i just assumed you only have problem on adding sheet.
Hope this helps.
In my worksheet some cells values are based on other cells
Info worksheet
A1: 5
B1: =A1
Design worksheet
A1:
Is there a way to copy and read the value in B1? I'm trying to use the value in a for loop, with no luck.
Sheets("Info").Select
For i = 1 to 5
If Range("B" & i).Value <> 0 Then
Range("B" & i).Copy Destination:=Sheets("Design").Range("A" & x)
'Sheets("Design").Range("A" & x).Value = Sheets("Offerte").Range("B" & i).Value
x = x + 1
End If
Next i
Your example doesn't seem to match the code well. The line
If Range("B" & i).Value = 1 Then
means that nothing will be copied in your example. It's looking for a cell with 1 in it. Why do you need that If statement at all?
EDIT I am guessing you're just checking that there's something in the cell to copy? I would probably do it this way:
If Trim(Range("B" & i).Value) <> "" Then
Also - did you miss out setting x=1?
There is more than one way to do it. One of them is using 'offset', which is a function that really worth understand. It basically points to a amount of rows / columns from the original cell.
Sub test()
Dim oCell As Excel.Range
Dim i As Integer
Dim x As Integer
Set oCell = Sheets("Info").Range("B1")
x = 1
For i = 1 To 5
If oCell.Offset(i, 0).Value = 1 Then
oCell.Offset(i, 0).Copy Destination:=Sheets("Design").Range("A" & x)
x = x + 1
End If
Next i
End Sub
Besides, you can assert the value instead of using the copy property. Notice it won't work unless x is an integer > 0.
Sub test2()
Sheets(3).Select
x = 1
For i = 1 To 5
If Range("B" & i).Value = 1 Then
Sheets(4).Range("A" & x).Value = Range("B" & i).Value
'Sheets("Design").Range("A" & x).Value = Sheets("Offerte").Range("B" & i).Value
x = x + 1
End If
Next i
End Sub