I'm trying to move texts after 40 characters to the next row added in Excel but the code below skips the for loop. When F8 key is used it jumps from 'For i = 1 to i = 50' to 'End Sub'.
Sub TextLimit()
Dim i As Long
For i = 1 To i = 50
If Len(Cells(i, 1)) > 40 Then
Rows(i + 1).Insert
Cells(i + 1, 1) = Mid(Cells(i, 1), 41, Len(Cells(i, 1)) - 40)
Else
End If
Next i
End Sub
I added the ending loop variable iend and variable incrementation when conidition is fulfilled
Sub TextLimit()
Dim i As Long, iend as long
iend = 50
For i = 1 To iend
If Len(Cells(i, 1)) > 40 Then
Rows(i + 1).Insert
Cells(i + 1, 1) = Mid(Cells(i, 1), 41, Len(Cells(i, 1)) - 40)
iend =iend +1
Else
End If
Next i
End Sub
I need to search Excel for a change in text in Col G and then sum the values in the 3 Col before. So far this works except the sum is static to x rows. I need it to be dynamic on the "RowCount" any help would be great. I am a couple days into it.
Dim iRow As Integer, Tags As Integer
Dim oRng As Range
Dim RowCount As Integer
Set oRng = Range("G2")
iRow = oRng.Row
Tags = oRng.Column
Do
'
If Cells(iRow + 1, Tags) <> Cells(iRow, Tags) Then
Cells(iRow + 1, Tags).EntireRow.Insert Shift:=xlDown
Cells(iRow + 1, Tags).Interior.Color = 65535
Cells(iRow + 1, Tags - 1).Interior.Color = 65535
Cells(iRow + 1, Tags - 2).Interior.Color = 65535
Cells(iRow + 1, Tags - 3).Interior.Color = 65535
Cells(iRow + 1, Tags - 4).Interior.Color = 65535
Cells(iRow + 1, Tags - 5).Interior.Color = 65535
Cells(iRow + 1, Tags - 6).Interior.Color = 65535
Cells(iRow + 1, Tags).Value = Trim(Cells(iRow, Tags - 6) & " " & (Cells(iRow, Tags)) & " Totals")
Cells(iRow + 1, Tags - 6).Value = Array("Totals")
Cells(iRow + 1, Tags - 1).Select
ActiveCell.FormulaR1C1 = "=SUM(R[-40]C:R[-1]C)" <<<<<<<<< the -40 I want to be the Integer of “RowCount”
Cells(iRow + 1, Tags - 2).Select
ActiveCell.FormulaR1C1 = "=SUM(R[-40]C:R[-1]C)" <<<<<<<<< the -40 I want to be the Integer of “RowCount”
Cells(iRow + 1, Tags - 3).Select
ActiveCell.FormulaR1C1 = "=SUM(R[-40]C:R[-1]C)" <<<<<<<<< the -40 I want to be the Integer of “RowCount”
iRow = iRow + 2
RowCount = 0
Else
iRow = iRow + 1
RowCount = RowCount + 1
End If
First compute the RowCount. Maybe this is what you want:
RowCount = iRow - 1
Which means you want to sum starting from the second row. You may need to tweak it.
Then
"=SUM(R[-" & RowCount & "]C:R[-1]C)"
I answered my own question, need quotes and & around RowCount
ActiveCell.FormulaR1C1 = "=SUM(R[-" & RowCount & "]C:R[-1]C)"
I have a bunch of subs for different categories in a table I'm building in excel. Each sub has its' own data it pulls from various flat files, but it all has the same ending which is placing each value into a specific cell based on the category header it aligns to in the row and column. So, all that is different is the if statement at the beginning. Is there a way to put this block of code in a separate sub or function or something and have just one call to it in each other sub so that I don't have to constantly type it out/ if I want to change it I would only have to change it in one place? Here is an example of the code:
This part is at the beginning of each sub and changes based on the row header
Sub calccategory()
For k = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
If Cells(k, 4) = "row 1" Then
This part is the part I want to place in a function or sub because it will be the same every time
Dim CWS As Worksheet
Workbooks(ThisBook).Activate
For j = 5 To 15
For g = 1 To ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
If Cells(3, g) = "col1" Then
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
On Error Resume Next
CWS.Cells(k, g).Value = col1_n
End With
ElseIf Cells(3, g) = "col2" Then
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
On Error Resume Next
CWS.Cells(k, g).Value = col2_n
End With
ElseIf Cells(3, g) = "col3" Then
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
On Error Resume Next
CWS.Cells(k, g).Value = col3_n
End With
ElseIf Cells(3, g) = "col 4" Then
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
On Error Resume Next
CWS.Cells(k, g).Value = col4_n
End With
ElseIf Cells(3, g) = "col5" Then
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
On Error Resume Next
CWS.Cells(k, g).Value = col5_n
End With
End If
Next g
On Error GoTo 0
Next j
This part would again me part of the end of each sub and not a part of this function I want
End If
Next k
End Sub
What you need to do, as I posted in a comment, is pass the arguments to the new sub. Also, you have lots of recurring code, so I tried to tighten that up.
Sub calccategory()
For k = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
If Cells(k, 4) = "row 1" Then
theLoop k
End If
Next k
End Sub
Sub theLoop(ByVal k As Integer)
Dim CWS As Worksheet
Set CWS = Workbooks(ThisBook)
For j = 5 To 15
With CWS
For g = 1 To .Cells(3, .Columns.Count).End(xlToLeft).Column
With .Range(.Cells(k, j * 4 + 2), .Cells(k + 1, j * 4 + 4))
On Error Resume Next
If .Cells(3, g) = "col1" Then .Cells(k, g).Value = col1_n
ElseIf .Cells(3, g) = "col2" Then .Cells(k, g).Value = col2_n
ElseIf .Cells(3, g) = "col3" Then .Cells(k, g).Value = col3_n
ElseIf .Cells(3, g) = "col 4" Then .Cells(k, g).Value = col4_n
ElseIf .Cells(3, g) = "col5" Then .Cells(k, g).Value = col5_n
End If
End With
Next g
End With 'CWS
On Error GoTo 0
Next j
End Sub
Well, you should do something like this...
Option Explicit
Public Sub CalCategoryInternal(ByVal str_col2 As String, _
ByVal g As Long, _
ByVal k As Long, _
ByVal j As Long, _
ByRef CWS As Worksheet)
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
On Error Resume Next
CWS.Cells(k, g).Value = str_col2
On Error GoTo 0
End With
End Sub
Sub calccategory()
Dim k, ThisBook, j, g, col1_n, col2_n, col3_n, col4_n, col5_n
For k = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
If Cells(k, 4) = "row 1" Then
Dim CWS As Worksheet
Workbooks(ThisBook).Activate
For j = 5 To 15
For g = 1 To ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
If Cells(3, g) = "col1" Then
Call CalCategoryInternal("col1", g, k, j, CWS)
' With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
' On Error Resume Next
' CWS.Cells(k, g).Value = col1_n
' End With
ElseIf Cells(3, g) = "col2" Then
Call CalCategoryInternal("col1", g, k, j, CWS)
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
On Error Resume Next
CWS.Cells(k, g).Value = col2_n
End With
ElseIf Cells(3, g) = "col3" Then
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
On Error Resume Next
CWS.Cells(k, g).Value = col3_n
End With
ElseIf Cells(3, g) = "col 4" Then
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
On Error Resume Next
CWS.Cells(k, g).Value = col4_n
End With
ElseIf Cells(3, g) = "col5" Then
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
On Error Resume Next
CWS.Cells(k, g).Value = col5_n
End With
End If
Next g
On Error GoTo 0
Next j
End If
Next k
End Sub
Beware - this is really a low quality code. E.g. the "Dim"s on the top should not be declared this way and you can improve it further a lot. I do not see where you set the worksheet, thus I suppose that this is just a small part of the code. Enjoy it!
yeah you can easily stick that in its own sub, and you can pass K into it as an argument by value, that would just look like this:
Sub calccategory()
For k = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
If Cells(k, 4) = row 1" Then
Call newSub(k)
End If
Next k
End Sub
Sub newSub(byval k as long)
Dim CWS As Worksheet
Workbooks(ThisBook).Activate
For j = 5 To 15
For g = 1 To ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
If Cells(3, g) = "col1" Then
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
On Error Resume Next
CWS.Cells(k, g).Value = col1_n
End With
ElseIf Cells(3, g) = "col2" Then
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
On Error Resume Next
CWS.Cells(k, g).Value = col2_n
End With
ElseIf Cells(3, g) = "col3" Then
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
On Error Resume Next
CWS.Cells(k, g).Value = col3_n
End With
ElseIf Cells(3, g) = "col 4" Then
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
On Error Resume Next
CWS.Cells(k, g).Value = col4_n
End With
ElseIf Cells(3, g) = "col5" Then
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))
On Error Resume Next
CWS.Cells(k, g).Value = col5_n
End With
End If
Next g
On Error GoTo 0
Next j
end sub
you might also consider using a select statement and nesting your select statement in your with range.. although it doesn't look like you're actually referencing your with statement so you can probably get rid of it.
I'd wonder where you're getting variables "ThisBook" "col1_n" / "col2_n" ... cause you might run into a "function or variable not defined" issue unless you define them either module wide or pass them in as arguments into the function.
You're also not defining CWS equal to anything so you might get an object required error. which is what I assume the on error resume next statements are about.
So some of the improvements might look similar to this:
Sub calccategory()
For k = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
If Cells(k, 4) = "row 1" Then
Call newSub(k)
End If
Next k
End Sub
Sub newSub(ByVal k As Long)
Dim CWS As Worksheet
Set CWS = Workbooks(ThisBook).Sheets("mySheetName")
For j = 5 To 15
On Error Resume Next
For g = 1 To ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
If Cells(3, g) = "col1" Then
With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4)) 'still unused
CWS.Cells(k, g).Value = col1_n
Select Case Cells(3, g)
Case "col2"
CWS.Cells(k, g).Value = col2_n
Case "col3"
CWS.Cells(k, g).Value = col3_n
Case "col 4"
CWS.Cells(k, g).Value = col4_n
Case "col5"
CWS.Cells(k, g).Value = col5_n
End Select
End With
End If
Next g
On Error GoTo 0
Next j
End Sub
Good luck!
meanwhile you're adding more info, I can throw in what follows:
Option Explicit
Sub calccategory()
Dim k As Long
Dim CWS As Worksheet
Dim col1_n As Variant, col2_n As Variant, col3_n As Variant, col4_n As Variant, col5_n As Variant
With ActiveSheet
For k = 1 To .Cells(Rows.Count, 4).End(xlUp).Row
If .Cells(k, 4) = "row 1" Then FillValues k, Workbooks("ThisBook").ActiveSheet, CWS, Array(col1_n, col2_n, col3_n, col4_n, col5_n)
Next k
End With
End Sub
Sub FillValues(k As Long, ws As Worksheet, CWS As Worksheet, colArray As Variant)
Dim j As Long, G As Long, col As Long
Dim strng As String
With ws
' For j = 5 To 15 '<--| I commented it since it seems not to be used anywhere, once removing that 'With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4))'
For G = 1 To .Cells(3, .Columns.Count).End(xlToLeft).Column
strng = .Cells(3, G).Value2
If Left(strng, 3) = "col" Then
If IsNumeric(Mid(strng, 4, 1)) Then
col = CLng(Mid(strng, 4, 1))
If col <= 5 Then CWS.Cells(k, G).Value = colArray(col - 1)
End If
End If
Next G
' Next j
End With
End Sub
but there's plenty of thing you should explain (ThisBook, CWS, With Range(Cells(k, j * 4 + 2), Cells(k + 1, j * 4 + 4)) )to make a sense of it!
I need to copy a lot of rows. I tried to do something.copy something else.paste but it's extremely slow
I tried to do
Range(..).value(formula) = Range(..).value(formula) but its not so good because i have a date there that turn to ######
I need a faster way to do this copy/paste
This is my code:
Function Last_Col(k As Long) As Long
Last_Col = Cells(k, Columns.Count).End(xlToLeft).Column
End Function
Function Last_Col_Doc() As Long
Last_Col_Doc = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Column
End Function
Function Is_Grouped(i As Long) As Boolean
Is_Grouped = (Cells(i, 2).Rows.OutlineLevel > 1)
End Function
Function Is_Bold(i As Long) As Boolean
Is_Bold = Cells(i, 2).Font.Bold
End Function
Function Print_NA(i As Long, k As Long) As Boolean
Range(Cells(i, 21), Cells(i, 21 + k - 2)).Value = "NA"
End Function
Function Last_Row() As Long
Last_Row = Cells(Rows.Count, "B").End(xlUp).Row
End Function
Sub EditParanoia()
Dim FrstBlkRow As Long
Dim flag As Boolean
Dim i As Long
Dim HeadLen As Long
FrstBlkRow = Last_Col(1) + 1
If FrstBlkRow < 25 Then 'first edit
flag = True
i = 2
Do While flag
If Is_Bold(i) Then
flag = False
Else
i = i + 1
End If
Loop
HeadLen = Last_Col(i)
Range(Cells(i, 2), Cells(i, HeadLen)).Copy
Range(Cells(1, FrstBlkRow), Cells(1, FrstBlkRow + HeadLen - 2)).PasteSpecial
Else
FrstBlkRow = 21
HeadLen = 10
End If
Dim j As Long
For i = 2 To Last_Row Step 1
If Not Is_Grouped(i) And Not Is_Grouped(i + 1) And Cells(i, FrstBlkRow + 1).Value = vbNullString Then
'if not part of group
Range(Cells(i, FrstBlkRow), Cells(i, FrstBlkRow + HeadLen - 2)).Value = "NA"
ElseIf Not Is_Grouped(i) And Is_Grouped(i + 1) And Is_Grouped(i + 2) And Not Is_Grouped(i + 3) Then
'if Part of group of 1 val
Range(Cells(i + 2, 2), Cells(i + 2, 2 + HeadLen - 2)).Copy
Range(Cells(i, FrstBlkRow), Cells(i, FrstBlkRow + HeadLen - 3)).PasteSpecial
ElseIf Not Is_Grouped(i) And Is_Grouped(i + 1) Then
'if part of group of more then one val
j = 1
Do Until Is_Grouped(i + j) And Not Is_Grouped(i + j + 1)
'j will get the langth of any group
j = j + 1
Loop
'past the relevant cell in the right place
Range(Cells(i + 2, 2), Cells(i + 2 + j - 1 - 1, 2 + HeadLen - 2)).Copy
Range(Cells(i, FrstBlkRow), Cells(i + j - 1 - 1, FrstBlkRow + HeadLen - 3)).PasteSpecial
'past the head respectively
Range(Cells(i, 1), Cells(i, 20)).Copy
Range(Cells(i + 1, 1), Cells(i + j - 2, FrstBlkRow - 1)).PasteSpecial
End If
Next
End Sub
When you say you've tried "Range(..).value(formula) = Range(..).value(formula)", what do you mean? You should be able to set two ranges equal to eachother:
Say A1:A10 has "Batman, 10-01-2015" and you want to copy that range to B1:B10, Range("B1:B10").Value = Range("A1:A10").Value. You can't do that? I tried it with dates, and it set the B range values to dates, no reformatting necessary.
I also notice in your code, you PasteSpecial, but don't specify what type of special paste. See the Microsoft (or this one) page for more info.
Sub NewPortName ()
If ThisWorkbook.Sheets("PAR Form").Cells(2, 7).Value = "RJ45" Then
ThisWorkbook.Sheets("PAR_import").Cells(16, 3).Value = "PCI-" + ThisWorkbook.Sheets("Equipment details").Cells(4, 4).Value + "-" + Left(ThisWorkbook.Sheets("PAR Form").Cells(2, 13), 7)
ElseIf ThisWorkbook.Sheets("PAR Form").Cells(2, 7).Value = "LC-LC" Then
ThisWorkbook.Sheets("PAR_import").Cells(16, 3).Value = "PFI-" + ThisWorkbook.Sheets("Equipment details").Cells(4, 4).Value + "-" + Left(ThisWorkbook.Sheets("PAR Form").Cells(2, 13), 10) + ":" + ThisWorkbook.Sheets("PAR Form").Cells(2, 36) + " to " + Left(ThisWorkbook.Sheets("PAR Form").Cells(2, 14), 10) + ":" + ThisWorkbook.Sheets("PAR Form").Cells(2, 38)
End If
If ThisWorkbook.Sheets("PAR Form").Cells(3, 7).Value = "RJ45" Then
ThisWorkbook.Sheets("PAR_import").Cells(17, 3).Value = "PCI-" + ThisWorkbook.Sheets("Equipment details").Cells(4, 4).Value + "-" + Left(ThisWorkbook.Sheets("PAR Form").Cells(3, 13), 7)
ElseIf ThisWorkbook.Sheets("PAR Form").Cells(3, 7).Value = "LC-LC" Then
ThisWorkbook.Sheets("PAR_import").Cells(17, 3).Value = "PFI-" + ThisWorkbook.Sheets("Equipment details").Cells(4, 4).Value + "-" + Left(ThisWorkbook.Sheets("PAR Form").Cells(3, 13), 10) + ":" + ThisWorkbook.Sheets("PAR Form").Cells(3, 36) + " to " + Left(ThisWorkbook.Sheets("PAR Form").Cells(3, 14), 10) + ":" + ThisWorkbook.Sheets("PAR Form").Cells(3, 38)
End If
End sub
I am currently modifying this line by line for individual cells due to the nature of the output over several ranges.
I am wondering if this can be simplified using Range, Two of the ranges in question out of 7 are (M2:M100) and (N2:N100)
I will need to repeat this code and change the cells individually over 700 times to reflect 700 individual cells if I can't make this abstract
Check it out,
Sub Button1_Click()
Dim sh As Worksheet, ws As Worksheet, Esh As Worksheet
Dim Rws As Long, Rng As Range, c As Range, cr
Dim s1 As String, s2 As String, s3 As String
Set sh = Sheets("PAR Form")
Set ws = Sheets("PAR_import")
Set Esh = Sheets("Equipment details")
s1 = "RJ45"
s2 = "LC-LC"
s3 = Esh.Cells(4, 4).Value
With sh
Rws = .Cells(.Rows.Count, "G").End(xlUp).Row
Set Rng = .Range(.Cells(2, "G"), .Cells(Rws, "G"))
End With
For Each c In Rng.Cells
cr = c.Row
If c = s1 Then
ws.Cells(cr + 14, 3).Value = "PCI-" + s3 + "-" + Left(sh.Cells(cr, 13), 7)
ElseIf c = s2 Then
ws.Cells(cr + 14, 3).Value = "PFI-" + s3 + "-" + Left(sh.Cells(cr, 13), 10) + ":" + sh.Cells(cr, 36) + " to " + Left(sh.Cells(cr, 14), 10) + ":" + sh.Cells(cr, 38)
End If
Next c
End Sub
You could always try a loop along the lines of the below:
Sub ing()
For i = 2 To 100
Select Case ThisWorkbook.Sheets("PAR Form").Cells(i, 7).Value
Case "RJ45"
ThisWorkbook.Sheets("PAR_import").Cells(i + 14, 3).Value = "PCI-" + ThisWorkbook.Sheets("Equipment details").Cells(4, 4).Value + "-" + Left(ThisWorkbook.Sheets("PAR Form").Cells(i, 13), 7)
Case "LC-LC"
ThisWorkbook.Sheets("PAR_import").Cells(i + 14, 3).Value = "PFI-" + ThisWorkbook.Sheets("Equipment details").Cells(4, 4).Value + "-" + Left(ThisWorkbook.Sheets("PAR Form").Cells(i, 13), 10) + ":" + ThisWorkbook.Sheets("PAR Form").Cells(i, 36) + " to " + Left(ThisWorkbook.Sheets("PAR Form").Cells(i, 14), 10) + ":" + ThisWorkbook.Sheets("PAR Form").Cells(i, 38)
End Select
Next i
End Sub