In range M:M there is text in each cell. I need to Bold ever time the date format yyyy-mm-dd appears in each cell in the range. I have been using the following formula to do the same operation for defined text but i am unable to get it to work when i am using wildcards.
I am not properly defining
Dim rCell As Range, sToFind As String, iSeek As Long
Dim myWord As String
myWord = "202#[-]##[-]##"
sToFind = myWord
For Each rCell In Range("M1:M1000")
iSeek = InStr(1, rCell.Value, sToFind)
Do While iSeek > 0
rCell.Characters(iSeek, Len(sToFind)).Font.Bold = True
iSeek = InStr(iSeek + 1, rCell.Value, sToFind)
Loop
Next
End Sub
Related
I am currently working on a project and am running into an error that says: Syntax error in aggregate argument: Expecting a single column argument with possible 'Child' qualifier. I have a column named "Total#" in a BusinessAnalytics data table. I want to sum the column together so that I can use it to calculate a percentage of members and percentage of nonmembers. How can I fix this?
My code for a data table with running totals
Dim decTotalNumber As Decimal
Dim decPercentSales As Decimal
Dim intRow As Integer
If chkRewards.Checked = True Then
intRow = 1 'member
Else
intRow = 0 'nonmember
End If
With BusinessAnalytics.Rows(intRow)
.Item("Total#") += 1
decTotalNumber = BusinessAnalytics.Compute("SUM(Total#)", Nothing)
decPercentSales = Convert.ToDecimal(.Item("Total#")) / decTotalNumber
.Item("%Total") = decPercentSales.ToString("P1")
End With
GridView3.DataSource = BusinessAnalytics
GridView3.DataBind()
Your column name contains non-alphanumeric characters, so it should be wrapped in square brackets or "`" (grave accent) quotes.
Expression
So your statement should be:
decTotalNumber = BusinessAnalytics.Compute("SUM([Total#])", Nothing)
I have over 200 sheets in an Excel workbook that are each formatted in a really odd way and I need to figure out how to compile all the data that I need into a single master sheet. I only need the values from certain cells and ranges (shown in the code below). I'd like the final compiled sheet to be in long-form (see attached image).
There is an attached image that is an example of the format of each sheet - it contains all the cells but does not contain any actual data. In reality, there is a lot of data - some sheets have >1000 rows.
I tried to use a function in R to read in all the sheets as separate data frames so that I could merge them but I couldn't get it to work. I then tried to use VBA, but I'm not familiar with the syntax. Here's what I came up with:
Sub Copy_Example()
Dim J As Integer
Dim s As Worksheet
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"
Worksheets("Sheet2").Range("D9").Copy Destination:=Worksheets("Combined").Range("A2")
Worksheets("Sheet2").Range("E2").Copy Destination:=Worksheets("Combined").Range("B2")
Worksheets("Sheet2").Range("E3").Copy Destination:=Worksheets("Combined").Range("C2")
Worksheets("Sheet2").Range("E4").Copy Destination:=Worksheets("Combined").Range("D2")
Worksheets("Sheet2").Range("E5").Copy Destination:=Worksheets("Combined").Range("E2")
Worksheets("Sheet2").Range("C22:C2000").Copy Destination:=Worksheets("Combined").Range("F1")
Worksheets("Sheet2").Range("E22:E2000").Copy Destination:=Worksheets("Combined").Range("G1")
Worksheets("Sheet2").Range("F22:F2000").Copy Destination:=Worksheets("Combined").Range("H1")
Worksheets("Sheet2").Range("G22:G2000").Copy Destination:=Worksheets("Combined").Range("I1")
Worksheets("Sheet2").Range("H22:H2000").Copy Destination:=Worksheets("Combined").Range("J1")
Worksheets("Sheet2").Range("I22:I2000").Copy Destination:=Worksheets("Combined").Range("K1")
End Sub
This VBA will copy and paste the correct columns and ranges into a newly created worksheet only for Sheet 2. I tried to integrate additional snippets of code so that this would run through all sheets in the workbook and paste the data below the last line previously added but I can't get it to work. I would also love to be able to add a column with the name of the sheet that the data has been copied from.
If anyone can help me with this, using either R or VBA, I would really appreciate it.
This is an example of the format of each sheet
This is an example of what I'd like the master compiled sheet to look like
Try the below code
Sub CopyToCombined()
Dim oComWS As Worksheet, oWS As Worksheet
Dim iLR As Long: iLR = 1
' Add New sheet as "Combined"
Set oComWS = ThisWorkbook.Worksheets.Add
oComWS.Name = "Combined"
' Loop through all sheets in the workbook and copy details in Combined sheet
For Each oWS In ThisWorkbook.Worksheets
If oWS.Name <> "Combined" Then
With oWS
oComWS.Range("A" & iLR).Value = .Range("A3").Value
oComWS.Range("B" & iLR).Value = .Range("B5").Value
oComWS.Range("C" & iLR).Value = .Range("C26").Value
End With
iLR = iLR + 1
End If
Next
End Sub
Above code will go through all sheets in your workbook and copy the relevant data (obviously you will have to change what you want to copy)
EDIT 1:
As per requirement, below code should update the Combined as you requested
Sub CopyToCombined()
Dim oComWS As Worksheet, oWS As Worksheet
Dim iLR As Long: iLR = 1
Dim iC As Long
Dim aCleanArray As Variant, aMyRange As Variant, aColumn As Variant
' Add New sheet as "Combined"
Set oComWS = ThisWorkbook.Worksheets.Add
oComWS.Name = "Combined"
' Set arrays
aMyRange = Array("C20:C50", "D20:D50") ' <-- Set all your ranges here (i.e. "C22:C2000", "E22:E2000", ...)
aColumn = Array("C", "D") ' <-- Set the columns here (i.e. "F", "G", ...)
' Loop through all sheets in the workbook and copy details in Combined sheet
For Each oWS In ThisWorkbook.Worksheets
If oWS.Name <> "Combined" Then
With oWS
oComWS.Range("A" & iLR).Value = .Range("A2").Value
oComWS.Range("B" & iLR).Value = .Range("B2").Value
For iC = LBound(aMyRange) To UBound(aMyRange)
aCleanArray = CleanUpArray(.Range(aMyRange(iC)).Value)
oComWS.Range(aColumn(iC) & iLR & ":" & aColumn(iC) & (iLR + UBound(aCleanArray))).Value = Application.Transpose(aCleanArray)
Next
End With
iLR = oComWS.Range(aColumn(0) & oComWS.Rows.Count).End(xlUp).Row + 1
End If
Next
End Sub
Function CleanUpArray(aIncomigArray As Variant) As Variant
Dim aTemp() As Variant
Dim iC As Long
ReDim aTemp(0 To 0)
For iC = LBound(aIncomigArray) To UBound(aIncomigArray)
If Not IsEmpty(aIncomigArray(iC, 1)) Then
aTemp(UBound(aTemp)) = aIncomigArray(iC, 1)
ReDim Preserve aTemp(UBound(aTemp) + 1)
End If
Next
ReDim Preserve aTemp(UBound(aTemp) - 1)
CleanUpArray = aTemp
End Function
Hope this helps
I modify a cell in an Excel file using R.
When this cell is manually changed, Worksheet_Change launches to indicate the date of the modification (in two other cells).
When I run my code in R, the date of the modification in column 46 (see VBA code ModificationDate1) is indicated. The date of the modification in column 40 (see VBA code ModificationDate2) doesn't appear. I get a VBA error 1004.
It is not indicated where the error appears. I can't click debug.
I would like the date of the modification in column 40 to also appear. (This later appears when I make a change directly in Excel.)
My code in R:
if (NewInput != CurrentData) {
xlApp <- COMCreate("Excel.Application")
wb <- xlApp[["Workbooks"]]$Open("path.xlsm")
sheet <- wb$Worksheets("Sheet1")
cell <- sheet$Cells(Outputrow + 6, 7)
cell[["Value"]] <- paste0(NewInput)
wb$Save()
xlApp$Quit()
}
My codes in vba:
Private Sub Worksheet_Change(ByVal Target As Range)
'**ModificationDate1**
Dim WorkRng As Range
Dim Rng As Range
LastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = Range(Cells(7, 7), Cells(LastRow, 7))
If Not Intersect(Target, Rng) Is Nothing Then
Call UnprotectCells
Cells(Target.Row, 46).Value = Date
Call ProtectCells
End If
'**ModificationDate2**
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Range(Cells(7, 3), Cells(LastRow, 4))
Set rng2 = Range(Cells(7, 7), Cells(LastRow, 10))
If Not Intersect(Target, Union(rng1, rng2)) Is Nothing Then
Call UnprotectCells
Cells(Target.Row, 40).Value = Date
Call ProtectCells
End If
End Sub
I have a csv as shown in the image below. The data is a set of separate tables, separated by a blank line, that I require to be in separate csv files.
After importing to R, I'd like to split the data into the various separate tables, and then write these tables to separate csv files. I had the idea of using some kind of string detect, as a 'new' table is signified by the first instance of 'Area' in the first column. Any ideas of how to approach the code for this in R? There are a bunch of tables and doing this manually isn't advisable.
There's a truncation problem too it seems, as the tables will be required to have a differing amounts of columns, however I don't expect that getting rid of NULL or NA data should be too difficult with this.
Thanks for any help.
I don't think R is the right tool for this kind of thing. You should always try to use the right tool based on the task. Since you have Excel installed run this VBA script. That will do what you want.
Sub page_endings()
Dim i As Long 'how many times for pagebreak
Dim searchvalue_for_break_after 'value to do pagebreak
searchvalue_for_break_after = ""
'column A must be filled in with value break after
'example row 6, 12, 18, 24 whatever row you want
'will loop until empty row in column A
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row + 1
If Range("A" & i).Value = searchvalue_for_break_after Then
'will add a pagebreak after the row with value break after
ActiveWindow.SelectedSheets.HPageBreaks.Add before:=Range("A" & i).Offset(1)
End If
Next i
Call Create_Separate_Sheet_For_Each_HPageBreak
End Sub
Sub Create_Separate_Sheet_For_Each_HPageBreak()
Dim HPB As HPageBreak
Dim RW As Long
Dim PageNum As Long
Dim Asheet As Worksheet
Dim Nsheet As Worksheet
Dim Acell As Range
'Sheet with the data, you can also use Sheets("Sheet1")
Set Asheet = ActiveSheet
If Asheet.HPageBreaks.Count = 0 Then
MsgBox "There are no HPageBreaks"
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'When the macro is ready we return to this cell on the ActiveSheet
Set Acell = Range("A1")
'Because of this bug we select a cell below your data
'http://support.microsoft.com/default.aspx?scid=kb;en-us;210663
Application.Goto Asheet.Range("A" & Rows.Count), True
RW = 1
PageNum = 1
For Each HPB In Asheet.HPageBreaks
'Add a sheet for the page
With Asheet.Parent
Set Nsheet = Worksheets.Add(after:=.Sheets(.Sheets.Count))
End With
'Give the sheet a name
On Error Resume Next
Nsheet.Name = "Page " & PageNum
If Err.Number > 0 Then
MsgBox "Change the name of : " & Nsheet.Name & " manually"
Err.Clear
End If
On Error GoTo 0
'Copy the cells from the page into the new sheet
With Asheet
.Range(.Cells(RW, "A"), .Cells(HPB.Location.Row - 1, "K")).Copy _
Nsheet.Cells(1)
End With
' If you want to make values of your formulas use this line also
' Nsheet.UsedRange.Value = Nsheet.UsedRange.Value
RW = HPB.Location.Row
PageNum = PageNum + 1
Next HPB
Asheet.DisplayPageBreaks = False
Application.Goto Acell, True
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Call SaveWorksheetsAsCsv
End Sub
Sub SaveWorksheetsAsCsv()
Dim WS As Excel.Worksheet
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "C:\Users\Excel\Desktop\"
For Each WS In ThisWorkbook.Worksheets
Sheets(WS.Name).Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & "-" & WS.Name & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Next
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
' about overwriting the original file.
End Sub
You should take each different table to the uppermost part. All in all, you have 5 tables with different dimensions (Table1: 11x13; Table2: 11x9; Table3: 3x12; Table4: 10x5; Table5: 6x7). Take them side-by-side in the above (A1:M11; N1:V11 etc.). The headings of tables would be in 1st row.
library(readxl)
# Use the path returned from getwd() function that is R's working directory
df <- as.data.frame(read_excel("C://Users//User//Documents//Revolution//Your.xlsx"))
Then, you can handle these 5 tables as:
Table1 <- df[,1:13]
Table2 <- df[,14:22]
Table3 <- df[1:3,23:34]
Table4 <- df[1:10,35:39]
Table5 <- df[1:6,40:46]
By caring dimensions stemmed from different row numbers in the assignmets, you do not face any NA or NULL value in Table1...Table5.
I am using a text box for input to my SQL query. Based on the input I create a certain query and display the data in a gridview.
However I wish to make an adjustment for my users.
They often make an input like PL26... However this is not a valid name in the database to search for. Therefore I want to CHECK their input, and alter it accordingly, so they don't have to think about it.
I happen to know that when they type PL26 the correct input would be PL000026 ... The entity to search for is always "PL" + 6 characters/numbers... so if they wrote PL155, the number/string I pass to the sql query should become PL + 000 + 155 = PL000155.
I hope someone can help me how to accomplish this. That is if it is possible?
My idea/Pseudo code would be something like
If tbInput.txt's FIRST 2 CHARS are PL, then check total length of string
if StringLength < 8 characters, then
if length = 2 then ADD 4 0' after PL...
if length = 3 then add 3 0's after PL...
if length = 3 then add 3 0's after PL..
etc
....
...
Here we go:
Private Sub Button21_Click(sender As System.Object, e As System.EventArgs) Handles Button21.Click
Debug.Print(formatCode("PL1"))
Debug.Print(formatCode("PL"))
Debug.Print(formatCode("PL01"))
Debug.Print(formatCode("PL155"))
End Sub
Private Function formatCode(userInput As String) As String
Dim returnVal As String
If userInput.Length < 8 Then
returnVal = String.Concat(userInput.Substring(0, 2), userInput.Substring(2, userInput.Length - 2).PadLeft(6, "0"))
Else
returnVal = userInput
End If
Return returnVal
End Function
You may need to add some validation ensuring it starts with PL etc.
The following will work as long as there are no other non-numeric characters in between the PL and the numbers. You can always add it in your validation.
Dim newInput As String
If (input.StartsWith("PL")) Then
input = input.Remove(0, 2)
End If
' If this fails then it means the input was not valid
Dim numberPart = Convert.ToInt32(input)
newInput = "PL" + numberPart.ToString("D6")
Exctract a number by removing prefix "PL"
Parse to Integer
Use Custom Numeric Format Strings(zero placeholder) for adding zeros and prefix
Const PREFIX As String = "PL"
Dim exctractedNumber As Int32
If Int32.TryParse(tbInput.txt.Replace(PREFIX, String.Empty), exctractedNumber) = False Then
'Error nahdling
Exit Sub
End If
Dim finalFormat As String = String.Format("'{0}'000000", PREFIX)
Dim finalValue As String = exctractedNumber.ToString(finalFormat)
I would make use of the handy PadLeft method:
Dim input As String = "PL26"
Dim number As String = input.Substring(2, input.Length - 2)
If number.Length <> 6 Then
number = number.PadLeft(6, "0"C)
End If
MSDN String.PadLeft