VBA code to clear just constants on destination sheet - vba

I have filtered my cumulative sales from SalesMasterSheet to different sheets each named after each particular customer but I got stuck at trying to add excel formulas because my VBA code always clears content of the range of cells on sheetActive.
I have tried the special cell method so as to clear only constants but it doesn't work.
Any help would be appreciated.
below is my code:
Private Sub Worksheet_activate()
Dim i, LastRow
LastRow = Sheets("MasterSheet").Range("A" & Rows.Count).End(xlUp).Row
Sheets("ACCIMA").Range("A1:L500").ClearContents
For i = 2 To LastRow
If Sheets("MasterSheet").Cells(i, "C").Value = "ACCIMA" Then
Sheets("MasterSheet").Cells(i, "C").EntireRow.Copy _
Destination:=Sheets("ACCIMA").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
End Sub
So far what it does is copy entries with "ACCIMA" on column C from Mastersheet to sheet("ACCIMA"), but i would like to put a formula in sheet("ACCIMA") but because Sheets("ACCIMA").Range("A1:L500").ClearContents
all formulas clear once i make the sheet active.

Given the low amount of informations you give I sort of understood your problem this way:
If your code always clears content of the range of cells on the active sheet you should try to add the worksheet you are working on in your code, e.g.
cells(1,1).value = "test"
would turn into
worksheets("customer1").cells(1,1).value = "test"
After new informations:
Copy the content of your range "A1:K500", ignore the column "L" which has your formular and then add your formulars in column "L".
worksheets("customer1").cells(1,1).formula = "..."
Keep in mind, that your syntax for the formula changes in comparison with the synatx on the actual excel sheet.
e.g.:
=IF(A1="empty";"empty";"not empty")
Will turn into:
worksheets("customer1").cells(1,1).formula = "=IF(A1=""empty"",""empty"",""not empty"")"

Related

VBA working in one macro excel properly but not in other macro excel

I have written a vba code to find match in dynamic column "F" with cell value i cell "i1". And when match found in the column " F" it will clear the content of the particular row.
The VBA is working fine in the excel marco where I have written the VBA code but to my surprise when I copy the same VBA code to a different excel macro having the same content in worksheet and run the VBA code it does not clear all the match content row i.e., it clear some of the match row leaving some of match row uncleared. Where I am doing the mistake?
Sub test()
Dim i as long
For i = 100 To 1 step -1
If Range("F" & i).Value = Range("i1").Value Then Rows(i).EntireRow.ClearContent
Next i
End Sub
IMHO you just have to fix your typo and copy the code into a module (not the worksheet or workbook module) and it will work on the active sheet.
Sub test()
Dim i As Long
For i = 100 To 1 Step -1
If Range("F" & i).Value = Range("i1").Value Then
Rows(i).EntireRow.ClearContents
End If
Next i
End Sub
Rows(i) and Range("F" & i) is defined implicitly which might refer to another sheet or even another workbook.
below is a sample code with use of sheet reference.
Dim i as long
Dim ws as Worksheet
Set ws = ThisWorkBook.Sheets("YourSheetName")
For i = 100 To 1 step -1
If ws.Range("F" & i).Value = ws.Range("i1").Value Then ws.Rows(i).EntireRow.ClearContents
Next i

Copy and paste things into the next empty cell in column

I've been trying to figure this out for ages. I've found an answer on StackOverflow but I get object error when trying to use it. I want to copy a set of data from a sheet based on a condition and then paste it in the next empty cell in a column on another sheet. This is my code:
Public list As Worksheet
Public bsawt As Worksheet
Sub Check2()
Set bsawt = Sheets("BSAW_TABLE")
Set list = Sheets("LIST")
lastrow = list.Cells(Rows.Count, "K").End(xlUp).Row
For x = 13 To lastrow
If list.Range("K" & x).Value = "BSAW" Then list.Range("L" & x).Copy Destination:=bsawt.Range("A1").End(xlDown).Offset(1, 0)
Next x
End Sub
If you have nothing in column A, or an entry in A1 only, then copying to this destination
Destination:=bsawt.Range("A1").End(xlDown).Offset(1, 0)
is equivalent to going to the last cell in column A in the worksheet and then attempting to go down one further row, which is clearly an impossibility. See also #PEH's comment.
Instead, work up from the bottom.
Destination:=bsawt.Range("A" & rows.count).End(xlup).Offset(1, 0)

excel vba - syntax error

I can't quite figure out what the syntax error in Excel VBA is, the error I am seeing is: "run-time error 1004: Application-defined or object-defined error"
Sheets("Totals").Select
x = Range("A139").Activate
Range("E139:AB166").Formula = "=INDEX(""Model""!$A$3:$Z$1000,MATCH($" & x & ",""Model""!$A$3:$A$1000,0),MATCH(E$3,""Model""!$A$3:$Z$3,0))"
I am attempting to use an Index Match Match formula where the index reference is another worksheet in the file. I am trying to populate the formula in Range E139:AB166, such that the x variable is locked to Column A and the last match function is locked on the third row (E$3).
x = Range("A139").Activate
This line of code should force the cursor to that cell in the 'model' worksheet. 'Model' is the name of the worksheet in the file. I thought "" were necessary to alert vba that the string refers to the worksheet name.
What if the worksheet name is comprised of two strings so "Model 1". What would be then the syntax, this?
""Model 1""!A3
'x' is the cell where new data is added, I wrote a line of code to have it dynamically changed.
x = Range("A" & insert_at).Activate
Where insert_at is a variable that equals the last row,in the worksheet that is not empty, + 1.
insert_at = lastRow + 1
So the idea is to dynamically add additional data from the 'Model' worksheet to the current worksheet 'Totals' below any existing data in the 'Totals worksheet.
I appreciate any assistance with this.
Thanks!
Type a correct working formula in E139 then use this little Sub I wrote once, to turn it into a vba usable formula string.
Sub RngToVba(src As Range)
'writes the VBA code to re-create the formulae in given range
'by Patrick Honorez - www.idevlop.com
'usage: from debug window, type RngToVba [L14:R14]
' or RngToVba range("L14:R14")
Dim c As Range
For Each c In src
Debug.Print "range(""" & c.Address & """).formula = """ & _
Replace(c.Formula, """", """""") & """"""
Next c
End Sub
And...for god's sake, stop using those useless select and activate.
Sheets("Totals").Range("E139:AB166").Formula = someString
is faster, easier to debug, and more readable.

Preserve null strings when assigning to .Value with VBA

(edit: added 2 more restrictions to solutions)
I have a table (listobject wise) in which I need to duplicate certain rows. I'm using SourceListRow.Range.Value2 = DestListRow.Range.Value2 for efficiency reasons (copying whole ranges in one go). All formula columns after the copied cell ranges auto-expand perfectly into the new rows and act upon the copied data. I'm using Excel 2010 here on Windows.
However, although I've already been using this sort of code for eons, I've only now stumbled upon an oddity when using Range.Value / Range.Value2: if you assign an empty string to it, the final cell value will not be an empty string, but it will be Empty. That is: the data isn't copied over faithfully, and the copy can differ from the source, especially if consecutive formulas use ISBLANK etc. on it. Therefore the same formula will have different results when working on the copy vs. the source.
See below test code. Open a new, blank, Excel workbook, go to VBA, add a new module and add the following code:
Sub Test()
ActiveSheet.Range("a1").Formula = "="""""
ActiveSheet.Range("b1").Formula = "=isblank(a1)"
ActiveSheet.Range("c1").Value2 = TypeName(ActiveSheet.Range("a1").Value2)
ActiveSheet.Range("a2").Value2 = ActiveSheet.Range("a1").Value2
ActiveSheet.Range("b2").Formula = "=isblank(a2)"
ActiveSheet.Range("c2").Value2 = TypeName(ActiveSheet.Range("a2").Value2)
ActiveSheet.Range("a3").Value2 = ""
ActiveSheet.Range("b3").Formula = "=isblank(a3)"
ActiveSheet.Range("c3").Value2 = TypeName(ActiveSheet.Range("a3").Value2)
ActiveSheet.Range("a4").Formula = ActiveSheet.Range("a1").Formula
ActiveSheet.Range("b4").Formula = "=isblank(a4)"
ActiveSheet.Range("c4").Value2 = TypeName(ActiveSheet.Range("a4").Value2)
Call ActiveSheet.Range("a1").Copy
Call ActiveSheet.Range("a5").PasteSpecial(xlPasteValues)
ActiveSheet.Range("b5").Formula = "=isblank(a5)"
ActiveSheet.Range("c5").Value2 = TypeName(ActiveSheet.Range("a5").Value2)
End Sub
Then run it and look at the sheet;
B1 tells FALSE (as it should - the cell is not empty), and C1 tells "String" (the cell value is indeed an empty string);
B2 tells TRUE, even though we just copied over A1's value as-is; C2 tells "Empty", while it should tell "String" if the value was copied over faithfully;
as a test, B3 tells TRUE, even though we just set it explicitly to an empty string; C3 again tells "Empty" to confirm the data mangling;
assigning Range.Formula to OtherRange.Formula works (the String data type is preserved in B4), but I do not want to copy formula's, I want to copy only the values!
as a test I mimic what the GUI would yield in A5, and sure enough, Copy/Paste-As-Values does preserve the is-an-empty-string state...
What to do?
using Range.Copy / Range.PasteSpecial(xlPasteValues) is unacceptable, performance-wise and clipboard-wise;
using .Formula is also not an option, because I want to copy the values;
I could iterate over all values in the array, testing if they're a null string and then setting those cell's formula to ="", but I want to copy whole multi-cell ranges in one go to gain efficiency here...
I can't use autofilters and such because my data lives in a table (a.k.a. ListObject); I could use the table's own autofilter, but people may have it in use already so I'd have to restore it afterwards which is too much of a kludge.
using Range.Find and Range.Replace is not an option either, since that changes the user's Find/Replace dialog settings.
All ideas appreciated!
SpecialCells(xlCellTypeBlank) and AutoFilter treat null strings differently. Is your source data filterable? If so, could you use a placeholder value and then change the cells to have .Formula = "=""""" after copying?
I took your sample code and generated the workbook, then added a row above it for a filter header. The below code would change all null strings to "ChangeMe"; you could then copy over the values and replace all instances of "ChangeMe" in your destination with "=""""" using Range.Replace.
Sub Test2()
ActiveSheet.Range("A2:A6").SpecialCells(xlCellTypeBlanks).Interior.Color = 255 'Just to prove that xlCellTypeBlanks only selects actual blanks
ActiveSheet.Range("A1:A6").AutoFilter Field:=1, Criteria1:="=" 'Shows both actual blanks and ZLS/null strings
ActiveSheet.Range("A1:A6").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True 'Be able to use SpecialCells(xlCellTypeVisible) to reference all ZLS
ActiveSheet.Range("A2:A6").SpecialCells(xlCellTypeVisible).Value2 = "ChangeMe"
'Now unfilter and unhide your data, copy using .Value2, then .Replace "ChangeMe" with "="""""
End Sub
I think that accomplishes what you are trying to do - let me know if this is the right direction for a solution.
Edit: misinterpreted original question. Below old answer is incorrect.
While not quite as efficient as your original code, using .AutoFilter is much more efficient than looping through many cells. Furthermore, .AutoFilter treats zero-length strings and empty cells the same.
Something like this:
Sub CopyAndClearFakeBlanks()
Dim WSSource As Worksheet
Dim WSDest As Worksheet
Dim LRow As Long
Dim LPasteRow As Long
Set WSSource = Sheets("Source Data")
Set WSDest = Sheets("Paste Here")
LRow = WSSource.Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row 'Note that this will ignore blanks, so you may want to use a different method for finding your last row. Depends on how your users would need the data if there are trailing blanks.
On Error Resume Next
LPasteRow = 2 'Always need at least one row before the data for filtering properly; you can delete after if necessary
LPasteRow = WSDest.Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row + 1
WSDest.AutoFilterMode = False
On Error GoTo 0 'ofc use proper error handling in your actual code
WSDest.Range("A" & LPasteRow & ":A" & LPasteRow + LRow - 1).Value2 = WSSource.Range("A1:A" & LRow).Value2
WSDest.Range("A" & LPasteRow - 1 & ":A" & LPasteRow + LRow).AutoFilter field:=1, Criteria1:="=" 'Show blank or ZLS only
On Error Resume Next
WSDest.Range("A" & LPasteRow & ":A" & LPasteRow + LRow).SpecialCells(xlCellTypeVisible).Clear 'Turn them into true blanks
WSDest.ShowAllData
WSDest.AutoFilterMode = False
On Error GoTo 0
Set WSDest = Nothing
Set WSSource = Nothing
End Sub

Excel VBA Copy Sheet/Line

I have 2 Master Sheets based on 2 conditions of location. I import this data from an Excel Workbook into a worksheet on the Master Sheet Workbook. I think it would be better if I was able to scan the first column (A for example) and if the row meets a certain condition it would move the entire row to the respective Master Sheet just below the current data. If it meets condition B it goes to the other master sheet. I can then use Remove Duplicates in Excel to filter the data. My current code is below and I am fairly new to VB Automation. Any ideas on what kind of code I could use to select and move the rows based on criteria into 2 seperate master worksheets?
Sub Copy_DataCDN()
Sheets("CDNDataDump").Range("A2:AC10000").Copy _
Sheets("CDN").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Sheets("CDN").Select
As you suggested, this can be done by looping through the cells in your condition column (in the example code it's column A).
Here's the example code for you to modify.
Sub MoveToSheets()
Dim dataSource As Worksheet: Set dataSource = ThisWorkbook.Sheets(1)
Dim dataTargetA As Worksheet: Set dataTargetA = ThisWorkbook.Sheets(2)
Dim dataTargetB As Worksheet: Set dataTargetB = ThisWorkbook.Sheets(3)
Dim dataSourceRange As Range: Set dataSourceRange = dataSource _
.Range("A1:A" & dataSource.Cells(dataSource.Rows.Count, "A").End(xlUp).Row)
For Each Cell In dataSourceRange
'Test 1 - I'm checking if the cell value is a number as an example.
If IsNumeric(Cell.Value) = True Then
dataTargetA.Range("A" & Rows.Count).End(xlUp).Offset(1).EntireRow.Value _
= Cell.EntireRow.Value
'Test 2 - Checking if the cell value is "e".
ElseIf Cell.Value = "e" Then
dataTargetB.Range("A" & Rows.Count).End(xlUp).Offset(1).EntireRow.Value _
= Cell.EntireRow.Value
End If
Next
End Sub
In the For Each Cell In dataSourceRange loop you can have as many conditions as you need. You could have more sheets to paste to as well.