Macro to convert every 9th column into numbers in excel - vba

For some reason, even when I select a column, right click, and format the cells to be numbers, I still get an alert with a green corner in the cell that says that it's a number stored as text. I then highlight the range, click the exclamation point in the yellow box, and convert the range to numbers.
The problem is that I have to do this for hundreds of ranges.
How can I make a macro to highlight a range (e.g. XP2:XP2700) in every 9th column, and convert the entire range to numbers?

This is a follow-up to the OP's previous question, which, I answered.
Load the data into an array typecast it into a number then write it back over the original range.
Sub ConvertToNumber()
Dim x As Long, y As Long
Dim Data
With Worksheets("CPR Test 2013-2015")
For y = 1 To 1582 Step 9
Data = .Cells(2, y).Resize(2699, 1).Value
For x = 1 To UBound(Data, 1)
If IsNumeric(Data(x, 1)) And Not IsEmpty(Data(x, 1)) Then
Data(x, 1) = CDbl(Data(x, 1))
End If
Next
.Cells(2, y).Resize(2699, 1).Value = Data
Next
End With
End Sub

Related

How to create a loop to read a range of cells and determine which have values and what is to the right of each

I'm trying to have a program that can read a range of cells which consist of 12 cells (let's say: P79, R79, T79, V79, X79, Z79, AB79, AD79, AF79, AH79, AJ79, AL79) and under those cells there are 6 cells (let's say: V81, X81, Z81, AB81, AD81, AF81), the program is looking for whether or not there are values typed in the cells within the described range.
The program should be able to read the cells from left to right on the top row and loop down to the bottom row and read that from right to left.
If all the cells in the top row have values in them, then the program breaks and doesn't read the values in the bottom row.
As the program reads the values from each cell it should create a table consisting of three columns (let's say: M88, N88, O88), the leftmost column should have the cell number (in order of cell as read by the program (whichever cell has a value first in the loop is given the number 1 and then the next cell to have a value is given number 2 etc.). The middle column should have whatever value is written in it's corresponding cell read from the range. The right column should have the value of whatever is to the right of each cell containing a value.
The first value to be read with a value should give the value "Left End" and the last value to read (whether or not it is the 12th cell to have a value in the top row or the leftmost cell to have a value in the bottom row) should give the value "Right end".
An example of what a row from the table could look like:
Cell # Cell Value Position/Left/Right
1 First Left End
This is the code I have so far:
Sub Code()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
Dim i As Integer, j As Integer, k As Integer
' First loop to compare a car to the rest after it
For i = 1 To 12
For j = i + 1 To 12
If Not IsEmpty(ws.Range("Cell_" & i)) And Not IsEmpty(ws.Range("Cell_" & j)) Then
ws.Range("B82").Offset(i).Value = j
Exit For
End If
Next j
Next i
' Loop backwards to find "Right End"
For k = 12 To 2 Step -1 '24 To 2
If Not IsEmpty(ws.Range("Cell_12")) Then
ws.Range("B82").Offset(12).Value = "Right End"
Exit For
' Has the "Right End" Follow when cars are left blank for lower row
ElseIf IsEmpty(ws.Range("Cell_" & k)) And Not IsEmpty(ws.Range("Cell_" & k - 1)) Then
ws.Range("B82").Offset(k - 1).Value = "Right End"
Exit For
End If
Next k
What I have here merely inserts a count into a cell range, what I'm trying to do is have my code actually read the cells in the range in the order I described and one at a time look at which cells have values written in them and look at which cells (with values in them) are to the right of any cell with a value and produce the table described above.
After reading your explanation, which was quite challenging I tried to recreate what you are asking.
I used cells A1:L1 with numbers 1 to 12. in the row below that A2:L2, some numbers have been added. with an if value <> "" you can see which cells contain a value.
In the second worksheet the table is made:
Sub test()
Dim a As Integer
Dim i As Integer
Dim name As String
ActiveWorkbook.Sheets(1).Activate
a = 1
For i = 1 To endcel
If Sheets(1).Range("a1").Offset(a, i - 1).Value <> "" Then
name = Sheets(1).Range("A1").Offset(a, i - 1).Value
Sheets(2).Activate
Sheets(2).Range("b2").Offset(i).Value = name
End If
Next i
End Sub
Does this help? You can adapt it a bit to your problem.
Good luck!

Tricky: Shifting all data from Column C to last occupied column, deleting all empty cells in between and shift all data to the right

Referring to the below picture, I am trying to take all the data points from column C to the last occupied column (in this case, N, but in other cases, they vary, but not exceeding column U) and shift them all to column (AA) as the last right column while deleting all empty cells in between.
I would really appreciate if someone can help me out here!
The intended output is as below:
you may want to try this
Option Explicit
Sub main()
Dim row As Range
Dim arr As Variant
With Worksheets("AlignSheetName") '<--| change "AlignSheetName" to your actual worksheet name
With Intersect(.UsedRange, .Columns(3).Resize(, .UsedRange.Columns(.UsedRange.Columns.Count).Column - 2))
For Each row In .Rows
arr = Split(WorksheetFunction.Trim(Join(Application.Transpose(Application.Transpose(row.Value)), " ")), " ")
row.ClearContents
row.Cells(1, 1).Offset(, 27 - 3 - WorksheetFunction.CountA(row) - 1).Resize(, WorksheetFunction.CountA(row)).Value = arr
Next row
End With
End With
End Sub

Code to compare each cell in a column to every cell in another column

I have two columns with random times and the times come from two different sources so the columns do not have the same amount of data points. I want to start with the first time in the first column and compare it to each time in the second column. If there is a match in times, I would like to pull relevant data. After a match is found (if there is one) I would like for the code to go to the second cell in the first column and compare it to every value in the second column and so on.
Here is the code I have so far:
Sub TransferInfo()
'Activate the Sub to Convert and Format Dates
Call ConvertDates
'Define Variables
Dim st As Worksheet
Dim ts As Worksheet
Dim lastrow As Long
Dim i As Integer
j = 2
'Find and set the last used row
Set st = ThisWorkbook.Worksheets("Data Table")
lastrow = st.Cells(st.Rows.Count, "B").End(xlUp).Row
Set ts = ThisWorkbook.Worksheets("ShopFloor")
'Cycle through/compare Row J, Column 18 based on each cell in Row I, Column 14
For i = 2 To lastrow
Do Until IsEmpty(ts.Cells(j, 8)) Or IsEmpty(st.Cells(j, 2))
If st.Cells(i, 14).Value = ts.Cells(j, 18).Value Then
st.Cells(i, 15).Value = ts.Cells(j, 2).Value
Exit Do
Else
st.Cells(i, 15).Value = ""
End If
j = j + 1
Loop
j = 2
Next i
End Sub
The other sub that I call at the beginning of this sub simply rounds the times in each column to the nearest 15 minute interval to increase the likelihood of matches between the columns.
My question is: The code does not copy and paste any more information although there are times that match between the two columns. Why would the code that I have not work? Also, with larger data sets I am afraid that this the code may crash Excel and because I have a loop within a loop trying to process a lot of data a lot of times, but I don't know of a more efficient way to accomplish what I am trying to without this code.
If anyone has any insights as to why this code doesn't work I would greatly appreciate any help.
Thanks!
Based on your code, it looks like you just need an INDEX/MATCH formula. Use this in O2 and copy down:
=IFERROR(INDEX(B:B,MATCH(N2,R:R,0)),"")
No need for VBA

Excel search for empty cells, check conditions, write text

I have been doing some basic VBA programming in Excel 2010 but I have been struggling with this challenge for some time. Basically, I have a sheet that is formatted like this (It actually has 62 columns and rows=# of days in the given month):
Column A will be hidden but is used in a few formulas.
Row 15 shows whether or not the station is open 24/7(all) or only Monday-Friday(M-F).
the values presented are arbitrary counts. However, a blank count represents a problem unless... the station is M-F and
I need to get my code to identify a station that is open M-F and then fill in any particular Sat. or Sun (for that station) with the word "closed." then search for the next station that is M-F and repeat the process.
Initially I was having my code start with an actual value and then use several activecell.offset functions to find empty cells and then check conditions but I couldn't get it to work out. Then I tried to check from the station name or the schedule row but I couldn't get the multiple if/nested offset statements to work either.
I would really appreciate any help or insight you could provide that would show me the best approach. I don't really need the code that does it I just need a pseudo code walk-through unless you are kind enough to write out the code.
Thanks for your help!
I had a similar problem I worked out before. I modified it to your spreadsheet:
Dim d As Long, s As Long
d = 1 'weekdays column
s = 40 'status row
Dim r As Long, c As Long
r = ActiveSheet.Cells(Rows.Count, d).End(xlUp).Row
c = ActiveSheet.Cells(s, Columns.Count).End(xlToLeft).Column
Dim i As Long, cell As Range
i = 0
Dim days() As Long
For Each cell In Range(Cells(1, d), Cells(r, d))
If cell.Value = "Sat" Or cell.Value = "Sun" Then
ReDim Preserve days(i)
days(i) = cell.Row
i = i + 1
End If
Next cell
For Each cell In Range(Cells(s, 1), Cells(s, c))
If cell.Value = "M-F" Then
For i = LBound(days) To UBound(days)
Cells(days(i), cell.Column).Value = "closed"
Next i
End If
Next cell

VBA - Copy Formatting of Range to Array

I'm creating a report with multiple columns. What I need is that the columns that show only whole numbers, no decimals, should be rounded to the whole number (so that it not only shows a rounded number, it actually equals a round number). The columns that show the numbers with two numbers after the decimal should not be rounded.
What I can do is:
If c.NumberFormat = "#,##0_);(#,##0)" Then
c.Formula = "=round(" & Right(strFormula, Len(strFormula) - 1) & ",0)"
End If
However, I have the entire report in an array, and I would like to just paste the whole array into the sheet rather than pasting one cell at a time. I would also rather not process and round each cell based on the cell formatting, rather I would like to copy the formatting of the range where the report will go into an array, and work from the array. I believe this will cut a few seconds off the process.
Is there a way to copy the formatting of a range into an array?
Is there a way to copy the formatting of a range into an array?
Focusing on the question as posed, yes, that can be done. Unfortunately, it can't done in a one-liner, in the way that a range's values can be assigned to an array with myArray = Range("A2:F25"), for example. (See, also, brettdj's comment.) Instead, you'd need something like:
Dim rng as Range
Dim formatArray() As String
Dim i as Long, j as Long
Set rng = Range(A2:F20) 'or whatever the range is
Redim formatArray(1 to rng.Rows.Count, 1 to rng.Columns.Count)
For i = 1 to rng.Rows.Count
For j = 1 to rng.Columns.Count
formatArray(i, j) = rng.Cells(i, j).NumberFormat
Next
Next
...
A couple of observations, though:
You actually only need to know the formatting for a single row of the range since, presumably, the number formatting in a column will not change mid-column.
That would simplify the code to:
...
Redim formatArray(1 to rng.Columns.Count)
For i = 1 to rng.Columns.Count
formatArray(i) = rng.Cells(1, i).NumberFormat
Next
...
assuming, for sake of example, that row 1 of the range has the necessary number formats.
I am curious why you would want to modify a formula on the worksheet so that it will round, since you could presumably do the calculation in your code, with rounding, and then write the resulting value back to the sheet for your report.
If you need to apply number formats to the values you are writing to the worksheet (not just modify formulas so that they will produce whole numbers), that can be done to whole columns within the range at once, i.e.,
...
For i = 1 to rng.Columns.Count
rng.Columns(i).NumberFormat = formatArray(i)
Next
...
If you need to convert the results of a cell's formula to a rounded value, you can do that with something like
rng.Cells(2, 5).Value = WorksheetFunction.Round(rng.Cells(2, 5).Value, 0)
to give an example for a single cell. This assumes, of course, that the data feeding into the formula are already in the sheet and that the formula has been recalculated.