View Full Version : Appendix Thread. 3 *
DocAElstein
02-09-2022, 11:45 PM
<div class="gmail_chip gmail_drive_chip">
<div class="gmail_chip gmail_drive_chip">
<p style="margin: 0px;"><span style="font-family: arial,helvetica,sans-serif; font-size: 10pt; color: #000000; text-decoration: none;"><a href="https://www.youtube.com/watch?v=5ckOWXGDL34&lc=UgyqZfLMydnVuNbtqTR4AaABAg. 9ZBy1PrRmM89ZEE6b4w03-">https://www.youtube.com/watch?v=5ckOWXGDL34&lc=UgyqZfLMydnVuNbtqTR4AaABAg. 9ZBy1PrRmM89ZEE6b4w03-</a> 7<br /></span></p>
<p style="margin: 0px;"><span style="font-family: arial,helvetica,sans-serif; font-size: 10pt; color: #000000; text-decoration: none;">https://www.youtube.com/watch?v=5ckOWXGDL34&lc=UgzW4-G9Rh2o5ljabrV4AaABAg</span> 13 </p>
</div>
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgykemWTw-fGoPwu8E14AaABAg.9iECYNx-n4U9iK75iCEaGN (https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgykemWTw-fGoPwu8E14AaABAg.9iECYNx-n4U9iK75iCEaGN)
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgykemWTw-fGoPwu8E14AaABAg.9iECYNx-n4U9iK7XF33njy (https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgykemWTw-fGoPwu8E14AaABAg.9iECYNx-n4U9iK7XF33njy)
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugy_1xkcndYdzUapw-J4AaABAg.9iGOq_leF_E9iKCSgpAqA1 (https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugy_1xkcndYdzUapw-J4AaABAg.9iGOq_leF_E9iKCSgpAqA1)
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugy_1xkcndYdzUapw-J4AaABAg.9iGOq_leF_E9iKCy--3x8E (https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugy_1xkcndYdzUapw-J4AaABAg.9iGOq_leF_E9iKCy--3x8E)
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwNaJiNATXshvJ0Zz94AaABAg.9iEktVkTAHk9iF9_pdsh r6 (https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwNaJiNATXshvJ0Zz94AaABAg.9iEktVkTAHk9iF9_pdsh r6)
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgykemWTw-fGoPwu8E14AaABAg.9iECYNx-n4U9iFAZq-JEZ- (https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgykemWTw-fGoPwu8E14AaABAg.9iECYNx-n4U9iFAZq-JEZ-)
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgxV2r7KQnuAyZVLHH54AaABAg.9iDVgy6wzct9iFBxma9z XI (https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgxV2r7KQnuAyZVLHH54AaABAg.9iDVgy6wzct9iFBxma9z XI)
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugx12mI-a39T41NaZ8F4AaABAg.9iDQqIP56NV9iFD0AkeeJG (https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugx12mI-a39T41NaZ8F4AaABAg.9iDQqIP56NV9iFD0AkeeJG)
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwnYuSngiuYaUhEMWN4AaABAg.9iDQN7TORHv9iFGQQ5z_ 3f (https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwnYuSngiuYaUhEMWN4AaABAg.9iDQN7TORHv9iFGQQ5z_ 3f)
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwJ3yzdk_EE98dndmt4AaABAg.9iDLC2uEPRW9iFGvgk11 nH (https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwJ3yzdk_EE98dndmt4AaABAg.9iDLC2uEPRW9iFGvgk11 nH)
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgyDWAVqCa4yMot463x4AaABAg.9iH3wvUZj3n9iHnpOxOe Xa (https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgyDWAVqCa4yMot463x4AaABAg.9iH3wvUZj3n9iHnpOxOe Xa)
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwvLFdMEAba5rLHIz94AaABAg.9iGReNGzP4v9iHoeaCpT G8 (https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwvLFdMEAba5rLHIz94AaABAg.9iGReNGzP4v9iHoeaCpT G8)
https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugy_1xkcndYdzUapw-J4AaABAg.9iGOq_leF_E9iHpsWCdJ5I (https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugy_1xkcndYdzUapw-J4AaABAg.9iGOq_leF_E9iHpsWCdJ5I)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9iHOYYpaA bC (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9iHOYYpaA bC)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgxuL6YCUckeUIh9hoh4AaABAg (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgxuL6YCUckeUIh9hoh4AaABAg)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwGTEyefOX7msIh1wZ4AaABAg.9h4sd6Vs4qE9h7G-bVm8_- (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwGTEyefOX7msIh1wZ4AaABAg.9h4sd6Vs4qE9h7G-bVm8_-)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=Ugw3nF0C04AGt73H1BB4AaABAg.9h6VhNCM-DZ9h7EqbG23kg (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=Ugw3nF0C04AGt73H1BB4AaABAg.9h6VhNCM-DZ9h7EqbG23kg)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwGTEyefOX7msIh1wZ4AaABAg.9h4sd6Vs4qE9h7KvJXmK 8o (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwGTEyefOX7msIh1wZ4AaABAg.9h4sd6Vs4qE9h7KvJXmK 8o)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=Ugw3nF0C04AGt73H1BB4AaABAg.9h6VhNCM-DZ9h7E1gwg4Aq (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=Ugw3nF0C04AGt73H1BB4AaABAg.9h6VhNCM-DZ9h7E1gwg4Aq)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgywFtBEpkHDuK55r214AaABAg (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgywFtBEpkHDuK55r214AaABAg)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79hNGvJ bu (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79hNGvJ bu)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79YAfa2 4T (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79YAfa2 4T)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79M1SYH 1E (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79M1SYH 1E)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h78SxhXT nR (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h78SxhXT nR)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
DocAElstein
02-09-2022, 11:45 PM
In support of this post https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12782
Security tweaks
# Will like XP or Win7 Disable Windows Defender Disable Defender Updates Set UAC to Never Prompt Disable Meltdown Flag Disable Windows Malware Scan
$securitylow.Add_Click({
Write-Host "Lowering UAC level..."
Set-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Po licies\System" -Name "ConsentPromptBehaviorAdmin" -Type DWord -Value 0
Set-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Po licies\System" -Name "PromptOnSecureDesktop" -Type DWord -Value 0
Write-Host "Disabling Windows Defender..."
If (!(Test-Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender")) {
New-Item -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender" -Force | Out-Null
}
Set-ItemProperty -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender" -Name "DisableAntiSpyware" -Type DWord -Value 1
If ([System.Environment]::OSVersion.Version.Build -eq 14393) {
Remove-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Ru n" -Name "WindowsDefender" -ErrorAction SilentlyContinue
} ElseIf ([System.Environment]::OSVersion.Version.Build -ge 15063) {
Remove-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Ru n" -Name "SecurityHealth" -ErrorAction SilentlyContinue
}
Write-Host "Disabling Windows Defender Cloud..."
If (!(Test-Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender\Spynet")) {
New-Item -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender\Spynet" -Force | Out-Null
}
Set-ItemProperty -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender\Spynet" -Name "SpynetReporting" -Type DWord -Value 0
Set-ItemProperty -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender\Spynet" -Name "SubmitSamplesConsent" -Type DWord -Value 2
Write-Host "Disabling Meltdown (CVE-2017-5754) compatibility flag..."
Remove-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Qu alityCompat" -Name "cadca5fe-87d3-4b96-b7fb-a231484277cc" -ErrorAction SilentlyContinue
Write-Host "Disabling Malicious Software Removal Tool offering..."
If (!(Test-Path "HKLM:\SOFTWARE\Policies\Microsoft\MRT")) {
New-Item -Path "HKLM:\SOFTWARE\Policies\Microsoft\MRT" | Out-Null
}
Set-ItemProperty -Path "HKLM:\SOFTWARE\Policies\Microsoft\MRT" -Name "DontOfferThroughWUAU" -Type DWord -Value 1
$wshell.Popup("Operation Completed",0,"Done",0x0)
})
# Enable Windows Malware Scan Enable Meltdown Flag Disable Windows Defender Set UAC to Always Prompt Disable Defender Updates
$securityhigh.Add_Click({
Write-Host "Raising UAC level..."
Set-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Po licies\System" -Name "ConsentPromptBehaviorAdmin" -Type DWord -Value 5
Set-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Po licies\System" -Name "PromptOnSecureDesktop" -Type DWord -Value 1
Write-Host "Disabling SMB 1.0 protocol..."
Set-SmbServerConfiguration -EnableSMB1Protocol $false -Force
Write-Host "Enabling Windows Defender..."
Remove-ItemProperty -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender" -Name "DisableAntiSpyware" -ErrorAction SilentlyContinue
If ([System.Environment]::OSVersion.Version.Build -eq 14393) {
Set-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Ru n" -Name "WindowsDefender" -Type ExpandString -Value "`"%ProgramFiles%\Windows Defender\MSASCuiL.exe`""
} ElseIf ([System.Environment]::OSVersion.Version.Build -ge 15063) {
Set-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Ru n" -Name "SecurityHealth" -Type ExpandString -Value "`"%ProgramFiles%\Windows Defender\MSASCuiL.exe`""
}
Write-Host "Enabling Windows Defender Cloud..."
Remove-ItemProperty -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender\Spynet" -Name "SpynetReporting" -ErrorAction SilentlyContinue
Remove-ItemProperty -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows Defender\Spynet" -Name "SubmitSamplesConsent" -ErrorAction SilentlyContinue
Write-Host "Disabling Windows Script Host..."
Set-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows Script Host\Settings" -Name "Enabled" -Type DWord -Value 0
Write-Host "Enabling Meltdown (CVE-2017-5754) compatibility flag..."
If (!(Test-Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Qu alityCompat")) {
New-Item -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Qu alityCompat" | Out-Null
}
Set-ItemProperty -Path "HKLM:\SOFTWARE\Microsoft\Windows\CurrentVersion\Qu alityCompat" -Name "cadca5fe-87d3-4b96-b7fb-a231484277cc" -Type DWord -Value 0
Write-Host "Enabling Malicious Software Removal Tool offering..."
Remove-ItemProperty -Path "HKLM:\SOFTWARE\Policies\Microsoft\MRT" -Name "DontOfferThroughWUAU" -ErrorAction SilentlyContinue
$wshell.Popup("Operation Completed",0,"Done",0x0)
})
DocAElstein
02-09-2022, 11:45 PM
In support of this post
https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12783
The ps1 file, and also below the $WindowsSearch.Add_Click(
Share ‘ChrisSearchTweaks18-19July.ps1 https://app.box.com/s/cbs7go8i2tdxw4wguthgxcviecaxjn6b
iex ((New-Object System.Net.WebClient).DownloadString(' https://raw.githubusercontent.com/ChrisTitusTech/win10script/71609526b132f5cd7e3b9167779af60051a80912/win10debloat.ps1'))
$windowssearch.Add_Click({
Write-Host "Disabling Bing Search in Start Menu..."
Set-ItemProperty -Path "HKCU:\Software\Microsoft\Windows\CurrentVersion\Se arch" -Name "BingSearchEnabled" -Type DWord -Value 0
<#
Write-Host "Disabling Cortana"
Set-ItemProperty -Path "HKCU:\SOFTWARE\Microsoft\Windows\CurrentVersion\Se arch" -Name "CortanaConsent" -Type DWord -Value 0
If (!(Test-Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows\Windows Search")) {
New-Item -Path "HKLM:\SOFTWARE\Policies\Microsoft\Windows\Windows Search" -Force | Out-Null
}
#>
Write-Host "Hiding Search Box / Button..."
Set-ItemProperty -Path "HKCU:\Software\Microsoft\Windows\CurrentVersion\Se arch" -Name "SearchboxTaskbarMode" -Type DWord -Value 0
Write-Host "Removing Start Menu Tiles"
Set-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -Value '<LayoutModificationTemplate xmlns:defaultlayout="http://schemas.microsoft.com/Start/2014/FullDefaultLayout" xmlns:start="http://schemas.microsoft.com/Start/2014/StartLayout" Version="1" xmlns="http://schemas.microsoft.com/Start/2014/LayoutModification">'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <LayoutOptions StartTileGroupCellWidth="6" />'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <DefaultLayoutOverride>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <StartLayoutCollection>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <defaultlayout:StartLayout GroupCellWidth="6" />'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' </StartLayoutCollection>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' </DefaultLayoutOverride>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <CustomTaskbarLayoutCollection>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <defaultlayout:TaskbarLayout>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <taskbar:TaskbarPinList>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <taskbar:UWA AppUserModelID="Microsoft.MicrosoftEdge_8wekyb3d8bbwe!MicrosoftEdg e" />'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' <taskbar:DesktopApp DesktopApplicationLinkPath="%APPDATA%\Microsoft\Windows\Start Menu\Programs\System Tools\File Explorer.lnk" />'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' </taskbar:TaskbarPinList>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' </defaultlayout:TaskbarLayout>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value ' </CustomTaskbarLayoutCollection>'
Add-Content -Path 'C:\Users\Default\AppData\Local\Microsoft\Windows\ Shell\DefaultLayouts.xml' -value '</LayoutModificationTemplate>'
$START_MENU_LAYOUT = @"
<LayoutModificationTemplate xmlns:defaultlayout="http://schemas.microsoft.com/Start/2014/FullDefaultLayout" xmlns:start="http://schemas.microsoft.com/Start/2014/StartLayout" Version="1" xmlns:taskbar="http://schemas.microsoft.com/Start/2014/TaskbarLayout" xmlns="http://schemas.microsoft.com/Start/2014/LayoutModification">
<LayoutOptions StartTileGroupCellWidth="6" />
<DefaultLayoutOverride>
<StartLayoutCollection>
<defaultlayout:StartLayout GroupCellWidth="6" />
</StartLayoutCollection>
</DefaultLayoutOverride>
</LayoutModificationTemplate>
"@
$layoutFile="C:\Windows\StartMenuLayout.xml"
#Delete layout file if it already exists
If(Test-Path $layoutFile)
{
Remove-Item $layoutFile
}
#Creates the blank layout file
$START_MENU_LAYOUT | Out-File $layoutFile -Encoding ASCII
$regAliases = @("HKLM", "HKCU")
#Assign the start layout and force it to apply with "LockedStartLayout" at both the machine and user level
foreach ($regAlias in $regAliases){
$basePath = $regAlias + ":\SOFTWARE\Policies\Microsoft\Windows"
$keyPath = $basePath + "\Explorer"
IF(!(Test-Path -Path $keyPath)) {
New-Item -Path $basePath -Name "Explorer"
}
Set-ItemProperty -Path $keyPath -Name "LockedStartLayout" -Value 1
Set-ItemProperty -Path $keyPath -Name "StartLayoutFile" -Value $layoutFile
}
#Restart Explorer, open the start menu (necessary to load the new layout), and give it a few seconds to process
Stop-Process -name explorer
Start-Sleep -s 5
$wshell = New-Object -ComObject wscript.shell; $wshell.SendKeys('^{ESCAPE}')
Start-Sleep -s 5
#Enable the ability to pin items again by disabling "LockedStartLayout"
foreach ($regAlias in $regAliases){
$basePath = $regAlias + ":\SOFTWARE\Policies\Microsoft\Windows"
$keyPath = $basePath + "\Explorer"
Set-ItemProperty -Path $keyPath -Name "LockedStartLayout" -Value 0
Write-Host "Search and Start Menu Tweaks Complete"
} # This was missing 12 July 2021
})
DocAElstein
02-09-2022, 11:45 PM
jADHKJASHDKJahdjkAHD
DocAElstein
02-09-2022, 11:45 PM
<div class="gmail_chip gmail_drive_chip"> </div>
<div class="gmail_chip gmail_drive_chip"><a href="https://drive.google.com/file/d/1UFQySI4QjTTV0O5xnLnLfx5iJh_qDzct/view?usp=drive_web" target="_blank" rel="noopener" aria-label="5.50 8.18 Clean Up Windows 10 _ 3 Steps For A Faster Computer-mWHiP9K8fQ0_16 10 2019.wmv"><img src="https://ssl.gstatic.com/docs/doclist/images/icon_10_generic_list.png" alt="" data-upload="true" /> <span dir="ltr">5.50 8.18 Clean Up Windows 10 _ 3 Steps For A ...</span></a><img src="res/6c654bc40d912309e7cc090257628b4f/texteditor/void.gif" alt="" data-upload="true" /></div>
<div class="gmail_chip gmail_drive_chip"><a href="https://drive.google.com/file/d/11mjTzHbcdY1EwVaV0-AIAmYgC2DCsp7X/view?usp=drive_web" target="_blank" rel="noopener" aria-label="7.56 8 (Ransome) How to Make Windows 10 Secure-pGcerfVqYyU_31 01 2020.wmv"><img src="https://ssl.gstatic.com/docs/doclist/images/icon_10_generic_list.png" alt="" data-upload="true" /> <span dir="ltr">7.56 8 (Ransome) How to Make Windows 10 Secur...</span></a><img src="res/6c654bc40d912309e7cc090257628b4f/texteditor/void.gif" alt="" data-upload="true" /></div>
<div class="gmail_chip gmail_drive_chip"><a href="https://drive.google.com/file/d/1b_akgpleMvL4lD4qXYffzUEXh8WhUyZ7/view?usp=drive_web" target="_blank" rel="noopener" aria-label="8.45 Speed Up Windows 10 in 2020-8E6OT_QcHaU_20 06 2020.wmv"><img src="https://ssl.gstatic.com/docs/doclist/images/icon_10_generic_list.png" alt="" data-upload="true" /> <span dir="ltr">8.45 Speed Up Windows 10 in 2020-8E6OT_QcHaU_20...</span></a><img src="res/6c654bc40d912309e7cc090257628b4f/texteditor/void.gif" alt="" data-upload="true" /></div>
<div class="gmail_chip gmail_drive_chip"> </div>
<div class="gmail_chip gmail_drive_chip"><a href="https://drive.google.com/file/d/1O63RdRCQS2OvWa50F56m6KyryVsBImIK/view?usp=drive_web" target="_blank" rel="noopener" aria-label="8.94 Creating New Windows 10 Debloat Scripts fo..."><img src="https://drive-thirdparty.googleusercontent.com/16/type/video/x-ms-wmv" alt="" data-upload="true" /> <span dir="ltr">8.94 Creating New Windows 10 Debloat Scripts fo...</span></a></div>
<div class="gmail_chip gmail_drive_chip"> </div>
DocAElstein
02-09-2022, 11:45 PM
khskjhkshhhfhfhfslhafhalfh
Amelynn
02-28-2022, 01:28 AM
Who can help me, I have the following code that I found somewhere that I don't remember:
Private Sub UserForm_Initialize()
Dim rng As Range
Set rng = Range("B4:D8")
With ComboBox1
.ColumnCount = 2
.ColumnWidths = "50;50"
' load 1st, 2nd columns of range into combobox
.List = Application.Index(rng, Evaluate("ROW(1:" & rng.Rows.Count & ")"), Array(1, 3))
End With
End Sub
In "sheet1" I have three columns of data in the range from B4 to D8 (the headers in row 3). In a combobox the data of columns B and D appears.This is a multicolumn combobox with non-continuous columns (that are not next to each other). It works perfectly and is adapted to what I wanted. Unfortunately I don't understand how the line
".List = Application.Index(rng, Evaluate("ROW(1:" & rng.Rows.Count & ")"), Array(1, 3))"
works and I can't stay So.
I know that we are making an output list from an input list and I understand that evaluate with row is returning the index of the rows that have data in the range, from the first row to the fifth, and that with array we determine the columns which will take the combobox (or so I thought I understood).
But why can't we use an array to determine the rows as well?
I tried to do it and it didn't work for me.
If someone is kind enough to tell me what data is returning evaluate (which is supposed to be used to occupy excel formulas in vba) with row, I would greatly appreciate it.
I hope everything is understood. I'm using google translator.
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgwWg8x2WxLSxxGsUP14AaABAg.9k3ShckGnhv9k89Lsaig oO (https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgwWg8x2WxLSxxGsUP14AaABAg.9k3ShckGnhv9k89Lsaig oO)
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgxxxIaK1pY8nNvx6JF4AaABAg.9k-vfnj3ivI9k8B2r_uRa2 (https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgxxxIaK1pY8nNvx6JF4AaABAg.9k-vfnj3ivI9k8B2r_uRa2)
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgxKFXBNd6Pwvcp4Bsd4AaABAg (https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgxKFXBNd6Pwvcp4Bsd4AaABAg)
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=Ugw9X6QS09LuZdZpBHJ4AaABAg (https://www.youtube.com/watch?v=yVgLmj0aojI&lc=Ugw9X6QS09LuZdZpBHJ4AaABAg)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h78GftO_ iE (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h78GftO_ iE)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h77HSGDH 4A (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h77HSGDH 4A)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h76fafzc EJ (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h76fafzc EJ)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h759YIjl aG (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h759YIjl aG)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h74pjGcb Eq (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9h74pjGcb Eq)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgzJJUDVv2Mb6YGkPYh4AaABAg.9h5uPRbWIZl9h7165DZd jg (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgzJJUDVv2Mb6YGkPYh4AaABAg.9h5uPRbWIZl9h7165DZd jg)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
DocAElstein
02-28-2022, 06:49 PM
Hello Amelynn
Welcome to ExcelFox , the thinking man’s Excel forum :)
Who can help me, ....I think, therefore I am , and able to help you.
...... I don't understand how the line ".List
= Application.Index(rng, Evaluate("ROW(1:" & rng.Rows.Count & ")"), Array(1, 3))
" works and I can't stay So....
To Explain
Question: _(i) What is Array(1, 3) ?
Answer_ It is like –
___1 _3
( Sometime we write in excel spreadsheet convention {1, 3} , but this usually means the same thing )
Question: _(ii)a) Evaluate("ROW(1:" & rng.Rows.Count & ")")
Answer:
..... evaluate (…….. used to occupy excel formulas in vba) with row,
Correct! Good! - Because you understand this, it makes the explanation for me much easier.
We are really only interested in understanding what is , =ROW(1:" & rng.Rows.Count & ")" , in excel spreadsheet formula
Question: _(ii)b) What is =ROW(1:" & rng.Rows.Count & ") ? ( in excel spreadsheet )
For your range, rng = B4:D8 , rng.Rows.Count = 5
=ROW(1: " & rng.Rows.Count & " )
=ROW(1: " & 5 & " )
=ROW(1:5)
( Green is Excel Spreadsheet, Blue is VBA in string “ “ in Evaluate( “ “ ) )
The excel spreadsheet Row( ) function is usually like for
Row( A1) = 1
but can also return a “vertical” array of values like
Row( A1:A2) = 1
Row( A1:A2) = 2
Inside VBA Evaluate “ _ “ we find that we are decoupled from spreadsheet absolute values, and so in inside VBA Evaluate “ _ “
Row(A1:A2) = Row( 1:2) = 1
Row(A1:A2) = Row( 1:2) = 2
ROW(1:5)
It is like
1
2
3
4
5
( Sometimes we may write
{1
2
3
4
5}
or sometimes we may write in excel spreadsheet convention , ={1;2;3;4;5} , but usually this means the same thing)
Note: For “vertical” array some excel use ; but some Excel use \ – So sometime you may need ={1\2\3\4\5}
Sometimes if we are lucky, Excel will try to do array calculations and return you an array.
Like
{ 1 2 X { 6 8 = { 1, 6 2, 8
3 4 } 7 9 } 3, 7 4, 9 }
But if you ask it to do = Index ___ , ROW(1:5)_ ,_ Array{1 , 3} it tries to look at columns and rows not specified.
This should not work
= { 1 ? { 1 3
2 ? ? ?
3 ? X ? ?
4 ? ? ?
5 ? } ? ? }
???? So we have a problem ?,
But we can be lucky again, because then Excel will guess to see the following instead, ( actually its more complicated then that, more precisely it is due to Excel VBA Interception and Implicit Intersection (http://www.excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp) , but we often say that Excel guesses things, as its often written to get things correct when you miss things out. ( In this particular case it is not clear if the phenomenum occurs by accident or design ) )
= { 1 1 { 1 3
2 2 1 3
3 3 X 1 3
4 4 1 3
5 5 } 1 3 }
( What is actually happening there above in those last two sketches is: -
If Excel is given a single row or a single column, but is being required to look at values of further adjoining rows and columns where no values are given, then the effect of the phenomena of Excel VBA Interception and Implicit Intersection (http://www.excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp) is that in certain situation the missing values will effectively be taken as a duplication of the values in the given row or column )
So, Index will try to give us
_______ Index( ( , 1, 1 1, 3
2, 1 2, 3
3, 1 3, 3
4, 1 4, 3
5, 1 5, 3 )
So if your range is, rng = B4:D8
-__=
_B4 _C4 _D4
_B5 _C5 _D5
_B6 _C6 _D6
_B7 _C7 _D7
_B8 _C8 _D8
then Application.Index(rng, Evaluate("=ROW(1:" & rng.Rows.Count & ")"), Array(1, 3))
-__ =Application.Index(rng, Evaluate("=ROW(1:5)"), Array(1, 3))
-__ =Application.Index(rng, Evaluate("={1;2;3;4;5}"), Array(1, 3))
-__ =Application.Index(rng, Evaluate("={1;2;3;4;5}"), Evaluate("={1, 3}"))
-__ =
rng , 1,1 1,3
2,1 2,3
3,1 3,3
4,1 4,3
5,1 5,3
-__=
_B4 _C4 _D4 1,1 1,3
_B5 _C5 _D5 2,1 2,3
_B6 _C6 _D6 3,1 3,3
_B7 _C7 _D7 4,1 4,3
_B8 _C8 _D8 5,1 5,3
= _B4 _D4
_B5 _D5
_B6 _D6
_B7 _D7
_B8 _D8
........use an array to determine the rows as well......
Sure, this is no problem:
One way, for example, for just 1st 3rd and 5th row
Change
Evaluate("={1;2;3;4;5}")
to
Evaluate("={1;3;5}")
-__ =Application.Index(rng, Evaluate("={1;3;5}"), Array(1, 3))
-__ =Application.Index(rng, Evaluate("={1;3;5}"), Evaluate("={1, 3}"))
_B4 _C4 _D4 1,1 1,3
_B5 _C5 _D5 3,1 3,3
_B6 _C6 _D6 5,1 5,3
_B7 _C7 _D7
_B8 _C8 _D8
= _B4 _D4
_B6 _D6
_B8 _D8
Here a demo macro for you
Put some arbitrary values in your range "B4:D8" , then run this macro:
Sub Test()
Dim Rng As Range
Set Rng = Worksheets("Sheet1").Range("B4:D8")
Dim RwsCnt As Long
Let RwsCnt = Rng.Rows.Count ' is = 5
Dim arr_List() As Variant
Let arr_List() = Application.Index(Rng, Evaluate("=ROW(1:" & Rng.Rows.Count & ")"), Array(1, 3))
Let arr_List() = Application.Index(Rng, Evaluate("=ROW(1:" & RwsCnt & ")"), Array(1, 3))
Let arr_List() = Application.Index(Rng, Evaluate("=ROW(1:5)"), Array(1, 3))
Let arr_List() = Application.Index(Rng, Evaluate("={1;2;3;4;5}"), Array(1, 3))
Let arr_List() = Application.Index(Rng, Evaluate("={1;2;3;4;5}"), Evaluate("={1,3}"))
Let Worksheets("Sheet1").Range("A40").Resize(UBound(arr_List(), 1), UBound(arr_List(), 2)).Value = arr_List()
' To only select 1st 3rd and 5th row
Let arr_List() = Application.Index(Rng, Evaluate("={1;3;5}"), Evaluate("={1,3}"))
Let Worksheets("Sheet1").Range("A47").Resize(UBound(arr_List(), 1), UBound(arr_List(), 2)).Value = arr_List()
End Sub
Alan
Amelynn
03-07-2022, 05:12 AM
Thank you so so so much! By your will and this incredible tutorial. I hope one day to have at least a fraction of your understanding of excel. I searched a lot for an explanation about this and I really appreciate that people like you exist. And I appreciate the internet too.
Thanks again DocAElstein, you are the best!
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwplzlpYpmRqjGZem14AaABAg.9hrvbYRwXvg9ht4b7z00 X0 (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwplzlpYpmRqjGZem14AaABAg.9hrvbYRwXvg9ht4b7z00 X0)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgyOGlCElBSbfPIzerF4AaABAg.9hrehNPPnBu9ht4us7Tt Pr (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgyOGlCElBSbfPIzerF4AaABAg.9hrehNPPnBu9ht4us7Tt Pr)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwHjKXf3ELkU4u4j254AaABAg.9hr503K8PDg9ht5mfLcg pR (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwHjKXf3ELkU4u4j254AaABAg.9hr503K8PDg9ht5mfLcg pR)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw1-OyZiDDxCHM2Rmp4AaABAg.9hqzs_MlQu-9ht5xNvQueN (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw1-OyZiDDxCHM2Rmp4AaABAg.9hqzs_MlQu-9ht5xNvQueN)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9htG01cKBzX (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9htG01cKBzX)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg.9ht16tzryC49htJ6TpIO XR (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg.9ht16tzryC49htJ6TpIO XR)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwMKwGZpDjv7vi7pCx4AaABAg (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwMKwGZpDjv7vi7pCx4AaABAg)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg.9ht16tzryC49htOKs4jh 3M (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg.9ht16tzryC49htOKs4jh 3M)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgxVW-am20rQ5GFuJ9F4AaABAg (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgxVW-am20rQ5GFuJ9F4AaABAg)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg.9htWqRrSIfP9i-fyT84gqd (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg.9htWqRrSIfP9i-fyT84gqd)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg.9htWqRrSIfP9i-kIDl-3C9 (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg.9htWqRrSIfP9i-kIDl-3C9)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i57J9GEOUB (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i57J9GEOUB)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i58MGeM8Lg (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i58MGeM8Lg)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i59prk5atY (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i59prk5atY)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwaWs6XDXdQybNb8tZ4AaABAg.9i5yTldIQBn9i7NB1gjy Bk (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwaWs6XDXdQybNb8tZ4AaABAg.9i5yTldIQBn9i7NB1gjy Bk)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgxV9eNHvztLfFBGsvZ4AaABAg.9i5jEuidRs99i7NUtNNy 1v (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgxV9eNHvztLfFBGsvZ4AaABAg.9i5jEuidRs99i7NUtNNy 1v)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugx2zSXUtmLBSDoNWph4AaABAg.9i3IA0y4fqp9i7NySrZa md (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugx2zSXUtmLBSDoNWph4AaABAg.9i3IA0y4fqp9i7NySrZa md)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9i7Qs8kxE qH (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9i7Qs8kxE qH)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9i7TqGQYq Tz (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9i7TqGQYq Tz)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAJSNws8 Zz (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAJSNws8 Zz)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAJvZ6km lx (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAJvZ6km lx)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAK0g1dU 7i (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAK0g1dU 7i)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKCDqNm nF (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKCDqNm nF)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKHVSTG Hy (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKHVSTG Hy)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKSBKPc J6 (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKSBKPc J6)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKgL6lr cT (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKgL6lr cT)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKlts8h KZ (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKlts8h KZ)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKrX7UP P0 (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAKrX7UP P0)
https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAL5MSjW pA (https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg.9hwsCHaKX6A9iAL5MSjW pA)
DocAElstein
03-28-2022, 04:13 PM
In support of these issues
https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12784 https://www.youtube.com/watch?v=dKM8ZScbic8&t=75s
Winget issues https://github.com/ChrisTitusTech/win10script/commit/f2774eac480a71e710f90763ea770ae56d3b6e85
https://github.com/ChrisTitusTech/win10script/commit/9c0cc78e2a15aed3d42fa1a0b3b236f3ecf290db
06.07.2021 The Best Windows Utility ( second nice shade of grey GUI )
Write-Host "Checking winget..."
Try{
# Check if winget is already installed
$er = (invoke-expression "winget -v") 2>&1
if ($lastexitcode) {throw $er}
Write-Host "winget is already installed."
}
Catch{
# winget is not installed. Install it from the Github release
Write-Host "winget is not found, installing it right now."
$download = "https://github.com/microsoft/winget-cli/releases/download/v1.0.11692/Microsoft.DesktopAppInstaller_8wekyb3d8bbwe.msixbu ndle"
$output = $PSScriptRoot + "\winget-latest.appxbundle"
Write-Host "Dowloading latest release"
Invoke-WebRequest -Uri $download -OutFile $output
Write-Host "Installing the package"
Add-AppxPackage -Path $output
}
Finally {
# Start installing the packages with winget
#Get-Content .\winget.txt | ForEach-Object {
# iex ("winget install -e " + $_)
#}
}
The Ultimate Windows Utility Upgrade 29 09 2021
Write-Host "Checking winget..."
Try{
# Check if winget is already installed
$er = (invoke-expression "winget -v") 2>&1
if ($lastexitcode) {throw $er}
Write-Host "winget is already installed."
}
Catch{
# winget is not installed. Install it from the Microsoft Store
Write-Host "winget is not found, installing it right now."
Start-Process "ms-appinstaller:?source=https://aka.ms/getwinget"
$nid = (Get-Process AppInstaller).id
Wait-Process -Id $nid
}
Finally {
# Start installing the packages with winget
#Get-Content .\winget.txt | ForEach-Object {
# iex ("winget install -e " + $_)
#}
}
A commit a bit later by mrhaydendp to simplify a bit https://github.com/ChrisTitusTech/win10script/commit/9c0cc78e2a15aed3d42fa1a0b3b236f3ecf290db?diff=spli t
Write-Host "Checking winget..."
# Check if winget is installed
if (Test-Path ~\AppData\Local\Microsoft\WindowsApps\winget.exe){
'Winget Already Installed'
}
else{
# Installing winget from the Microsoft Store
Write-Host "Winget not found, installing it now."
Start-Process "ms-appinstaller:?source=https://aka.ms/getwinget"
$nid = (Get-Process AppInstaller).Id
Wait-Process -Id $nid
Write-Host Winget Installed
}
DocAElstein
04-16-2022, 10:23 PM
Test
17-121-114-118.applebot.apple.com
header1header2A Header Last Column Header
0SubItemSubItemSubItemSubItem<-- This is a ListView Item. It has an Item number of 0 and an Item idenitfier/name of 345
1SubItemSubItemSubItemSubItem<-- This is a ListView Item. It has an Item number of 1 and an Item idenitfier/name of 232
2SubItemSubItemSubItemSubItem<-- This is a ListView Item. It has an Item number of 2 and an Item idenitfier/name of 36
header1header2A Header Last Column Header
0SubItemSubItemSubItem<-- This brown thing is a ListView Item. It has an Item number of 0 and an Item idenitfier/name of 345
1SubItemSubItemSubItem<-- This blue thing is a ListView Item. It has an Item number of 1 and an Item idenitfier/name of 232
2SubItemSubItemSubItem<-- This purple thing is a ListView Item. It has an Item number of 2 and an Item idenitfier/name of 36
[size=0]
header1header2A Header Last Header<-- This bit with the created “column” is part of the main ListView object
0\ 345 SubItemSubItemSubItem<-- This brown thing is a ListViewItem object. It has an Item number of 0,
and an Item identifier/name of 345
1\ 232 SubItemSubItemSubItem<-- This blue thing is a ListViewItem object. It has an Item number of 1,
and an Item identifier/name of 232
2\ 36 SubItemSubItemSubItem<-- This purple thing is a ListViewItem object. It has an Item number of 2
and an Item identifier/name of 36
__
In the above schematic we are showing 4 objects. The last three belong to the first one, ( after they have been ned to it ).
The values in the first column somehow belong to the main ListView object.
SubItems are Added to the ListViewItems
DocAElstein
04-26-2022, 12:19 PM
In support of this Thread https://eileenslounge.com/viewtopic.php?f=30&t=38110
https://eileenslounge.com/viewtopic.php?p=294721#p294721
Vertical to Horizontal,
This https://i.postimg.cc/14t4nPfD/This-Virtical.jpg (https://postimg.cc/14t4nPfD) to this https://i.postimg.cc/ygfdQprJ/That-Horizintal.jpg (https://postimg.cc/ygfdQprJ)
Part 1 The main data Vertical to Horizontal
An idea I have is to build up the single string that we know can be put into the Windows Clipboard, and then pasted out into Excel. ( http://www.eileenslounge.com/viewtopic.php?p=242941#p242941 )
I basically build that up with some Do While Loopy stuff
The Full Story
The usual worksheets defining and data getting information stuff.
( We capture one extra empty row, because, past experience with these sort of Do While Loopy stuff has shown that it can help simplify some conditional comparison things and/ or help prevent arrays doing out of bounds by one row.
Rem 1
The purpose of this is to get that maximum Amounts or Notes count, ( the biggest group ) ( which is 4 in the given example )
But its worth looking at how that works since the basic Do While Loop is then used in the next main ( Rem 2 ) section.
The #### Main Outer Loop keeps us going through all data rows
Within that the ' ---- Inner Loop that takes us through a group
This loop adds the things in the group, and after each loop is finished we check If the count was the biggest group so far.
Rem 2
This is the main meat of the solution.
First, exactly as before we have a #### Main Outer Loop keeps us going through all data rows
Within that Main Outer Loop we now have 2 inner loops.
'2a
The '2a The first inner loop one does something similar to before. It loops for a group. This time within it we build up two strings that we need for a line in the output.
As example, for the first group we are basically trying to build up these two strings, ( Just before we start that loop, we tack onto the string at the start the group name, which is A in the first group example.
This is what we would see, for example in the immediate window, for querying the string content after, in this example, the the loops for that inner loop
? strClipL
A vbTab 10 vbTab 20 vbTab 30
? strClipR
vbTab N1 vbTab N2 vbTab N3
( For the sake of clarity I use a vbTab to indicate the “invisible” vbTab characters, which is actually on those strings )
'2b
The purpose of '2b the second inner loop is to ,( if necessary ), give us effectively extra empty cells, ( achieved by adding a vbTab of the strings.
Using the same example, we would see that the loop is needed to be done once, and at the end of that single loop, our strings are modifies such:
? strClipL
A vbTab 10 vbTab 20 vbTab 30 vbTab
? strClipR
vbTab N1 vbTab N2 vbTab N3 vbTab
'2c
At this point we combine the two strings and add a line separator so that this row data can be added onto by the next row data
So as to be sure what I have and demonstrate it more clearly, I added a line in testing which calls a function of mine , ( https://excelfox.com/forum/showthread.php/2302-quot-What%e2%80%99s-in-a-String-quot-VBA-break-down-Loop-through-character-contents-of-a-string?p=15522&viewfull=1#post15522 ) , which checks that line screen,
Here is the result
"A" & vbTab & "10" & vbTab & "20" & vbTab & "30" & vbTab & vbTab & "N1" & vbTab & "N2" & vbTab & "N3" & vbTab & vbTab & "GroupA" & vbCr & vbLf
That looks about correct.
Doing a few other tests, suggest to me that I have the final result that I need: https://i.postimg.cc/xcbJDZgM/StrClip.jpg (https://postimg.cc/xcbJDZgM)
? strclip
A 10 20 30 N1 N2 N3 GroupA
B 40 50 60 70 N4 N5 N6 N7 GroupB
C 80 N8 GroupC
D 90 100 N9 N10 GroupD
"A" & vbTab & "10" & vbTab & "20" & vbTab & "30" & vbTab & vbTab & "N1" & vbTab & "N2" & vbTab & "N3" & vbTab & vbTab & "GroupA" & vbCr & vbLf & "B" & vbTab & "40" & vbTab & "50" & vbTab & "60" & vbTab & "70" & vbTab & "N4" & vbTab & "N5" & vbTab & "N6" & vbTab & "N7" & vbTab & "GroupB" & vbCr & vbLf & "C" & vbTab & "80" & vbTab & vbTab & vbTab & vbTab & "N8" & vbTab & vbTab & vbTab & vbTab & "GroupC" & vbCr & vbLf & "D" & vbTab & "90" & vbTab & "100" & vbTab & vbTab & vbTab & "N9" & vbTab & "N10" & vbTab & vbTab & vbTab & "GroupD" & vbCr & vbLf
' Ref
' http://www.eileenslounge.com/viewtopic.php?f=30&t=31395#p242941
' http://www.eileenslounge.com/viewtopic.php?f=30&t=31489#p243731
' http://www.eileenslounge.com/viewtopic.php?f=30&t=31938#p247681
' http://www.eileenslounge.com/viewtopic.php?f=30&t=31849&start=20#p246887
https://eileenslounge.com/viewtopic.php?p=294721#p294721
' http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
' https://stackoverflow.com/questions/25091571/strange-behavior-from-vba-dataobject-gettext-returns-what-is-currently-on-the-c/54960767#54960767
' https://stackoverflow.com/questions/31439866/multiple-variable-arguments-to-application-ontime/59812342#59812342
‘ http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
‘ https://www.myonlinetraininghub.com/excel-clipboard https://support.microsoft.com/en-us/office/copy-and-paste-using-the-office-clipboard-714a72af-1ad4-450f-8708-c2931e73ec8a?ui=en-us&rs=en-us&ad=us&fromar=1#bm2b
‘ https://www.thespreadsheetguru.com/blog/2014/2/20/how-to-create-a-personal-macro-file
‘ https://excelribbon.tips.net/T009810_Cant_Empty_the_Clipboard.html
‘ https://www.excelforum.com/excel-programming-vba-macros/1288935-copy-to-clipboard-not-working.html
‘ https://www.thespreadsheetguru.com/blog/2015/1/13/how-to-use-vba-code-to-copy-text-to-the-clipboard
https://excelribbon.tips.net/T010691_Message_about_a_Problem_with_the_Clipboard .html
https://excel.tips.net/T003111_Cant_Copy_Data_between_Workbooks.html
' VBA to clear the Office Clipboard http://www.eileenslounge.com/viewtopic.php?p=246838&sid=e1b0b87e47d419c09c526558cc634c64#p246838
DocAElstein
04-26-2022, 06:16 PM
Coding so far , for last post, https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16529&viewfull=1#post16529
' https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16529&viewfull=1#post16529
' http://www.eileenslounge.com/viewtopic.php?f=30&t=38110&p=294692#p294692
Sub Stantial()
Rem 0 data
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets("Sheet1")
Dim RngPlus1 As Range
Set RngPlus1 = Ws1.Cells.Item(1).CurrentRegion.Resize(Ws1.Cells.I tem(1).CurrentRegion.Rows.Count + 1, Ws1.Cells.Item(1).CurrentRegion.Columns.Count)
Dim vArr() As Variant: Let vArr() = RngPlus1.Value2
Rem 1 determine the biggest group ( that maximum Amounts or Notes count )
Dim Cnt As Long, Cnt2 As Long, Mx As Long: Let Mx = 1: Let Cnt = 1
Do ' ############################# Main Outer Loop keeps us going through all data rows
Do ' ----------------- Inner Loop that takes us through a group
Let Cnt = Cnt + 1 ' Cnt is the main data row number
Let Cnt2 = Cnt2 + 1
Loop While vArr(Cnt + 1, 1) = vArr(Cnt, 1) ' ---- Inner Loop that takes us through a group
If Cnt2 > Mx Then Let Mx = Cnt2
Let Cnt2 = 0
Loop While Cnt < UBound(vArr(), 1) - 1 ' #### Main Outer Loop keeps us going through all data rows
Rem 2 ' ############################# Main Outer Loop keeps us going through all data rows
Let Cnt = 1
Do
Dim HrCnt As Long: Let HrCnt = 1
Dim strClipR As String, strClipL As String: Let strClipL = strClipL & vArr(Cnt + 1, 1)
Do '2a The first inner loop
Let Cnt = Cnt + 1
Let HrCnt = HrCnt + 1
Let strClipL = strClipL & vbTab & vArr(Cnt, 2)
Let strClipR = strClipR & vbTab & vArr(Cnt, 3)
Loop While vArr(Cnt + 1, 1) = vArr(Cnt, 1) ' The first inner loop
Do While HrCnt < Mx + 1 '2b the second inner loop
Let strClipL = strClipL & vbTab
Let strClipR = strClipR & vbTab
Let HrCnt = HrCnt + 1
Loop ' the second inner loop
'2c Finishing off the strings, and final string for an output line, after the inner loops
Let strClipR = strClipR & vbTab & vArr(Cnt, 4) ' add the group name
Dim strClip As String: Let strClip = strClip & strClipL & strClipR & vbCr & vbLf ' join the strings and add a line seperator to the output row string
'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strClip)
Let strClipL = "": strClipR = ""
Loop While Cnt < UBound(vArr(), 1) - 1 ' #### Main Outer Loop keeps us going through all data rows
'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strClip)
'2d paste strClip out via the windows Clipboard
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
objDataObject.SetText Text:=strClip
objDataObject.PutInClipboard
Ws1.Paste Destination:=Ws1.Range("G2")
End Sub
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9iHOYYpaA bC (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg.9h740K6COOA9iHOYYpaA bC)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgxuL6YCUckeUIh9hoh4AaABAg (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgxuL6YCUckeUIh9hoh4AaABAg)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwGTEyefOX7msIh1wZ4AaABAg.9h4sd6Vs4qE9h7G-bVm8_- (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwGTEyefOX7msIh1wZ4AaABAg.9h4sd6Vs4qE9h7G-bVm8_-)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=Ugw3nF0C04AGt73H1BB4AaABAg.9h6VhNCM-DZ9h7EqbG23kg (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=Ugw3nF0C04AGt73H1BB4AaABAg.9h6VhNCM-DZ9h7EqbG23kg)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwGTEyefOX7msIh1wZ4AaABAg.9h4sd6Vs4qE9h7KvJXmK 8o (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwGTEyefOX7msIh1wZ4AaABAg.9h4sd6Vs4qE9h7KvJXmK 8o)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=Ugw3nF0C04AGt73H1BB4AaABAg.9h6VhNCM-DZ9h7E1gwg4Aq (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=Ugw3nF0C04AGt73H1BB4AaABAg.9h6VhNCM-DZ9h7E1gwg4Aq)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgywFtBEpkHDuK55r214AaABAg (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgywFtBEpkHDuK55r214AaABAg)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79hNGvJ bu (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79hNGvJ bu)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79YAfa2 4T (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79YAfa2 4T)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79M1SYH 1E (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h79M1SYH 1E)
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h78SxhXT nR (https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg.9h5lFRmix1R9h78SxhXT nR)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
DocAElstein
04-26-2022, 06:18 PM
Spare post for later
Row\ColABCD
1NumbersIDDate
2123452201/03/2022
3123452201/03/2022
4123452201/03/2022
5123452201/03/2022
6123452201/05/2022
7123452201/05/2022
8123452201/06/2022
9123452201/06/2022
10123452204/02/2022
11123452204/02/2022
12123452204/02/2022
13123452204/03/2022
14123452204/03/2022
15123452204/04/2022
16234562201/03/2022
17234562201/03/2022
18234562201/03/2022
19234562201/04/2022
20234562201/04/2022
21
Worksheet: Data
And this is your results.
Row\ColABCDEFG
1NumberIDStart DateEnd DateDaysWorking Days
2123452201/03/202204/04/20229264Incorrect
3234562201/03/202201/04/202221
4
5
6
7123452201/03/202201/06/202243Correct
8123452204/02/202204/04/202230
Worksheet: Result
It is impossible to understand why you have more than one result for 12345
DocAElstein
04-26-2022, 06:40 PM
Following on from posts,
https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16530&viewfull=1#post16530 https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16529&viewfull=1#post16529
http://www.eileenslounge.com/viewtopic.php?p=294692#p294692
,
The header row,
Group Amount1 Amount2 Amount3 Amount4 Notes1 Notes2 Notes3 Notes4 Name
, we could make partially dynamic, as is needed, since we don’t know the maximum number of amounts ( = maximum number of Notes ) , before seeing the data.
We do have the information needed, since Mx contains, in our current example, the required value of 4
Evaluate Range techniques are a convenient way to get these sort of things.
We start by considering spreadsheet formulas such as this,
={"Amount" & COLUMN(A1:D1)}
, which returns us an array, which applied across a range , would give us like
Amount1 Amount2 Amount3 Amount4 https://i.postimg.cc/vxWK4VnG/Amounts-Via-Spreadsheet-Array-Formula.jpg (https://postimg.cc/vxWK4VnG)
Taking that general idea and a few other steps we can finally get at our heading like in this demo coding
' https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16532&viewfull=1#post16532
Sub MakeHeadings()
Dim Mx As Long: Let Mx = 4
Dim Amounts() As Variant
Let Amounts() = Evaluate("=""Amount"" & COLUMN(A1:D1)")
Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:D)")
Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:" & "D" & ")")
' We need to get D from what we know, Mx
Dim vTemp As Variant
vTemp = Cells(1, 4).Address
vTemp = Split(vTemp, "$", 3, vbBinaryCompare)
vTemp = vTemp(1)
' Or
vTemp = Split(Cells(1, 4).Address, "$", 3, vbBinaryCompare)(1)
' Or
vTemp = Split(Cells(1, 4).Address, "$")(1)
vTemp = Split(Cells(1, Mx).Address, "$")(1)
Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:" & vTemp & ")")
Let Amounts() = Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")")
'
' We want this array as a string with vbTabs seperating the array elements
Dim strAmounts As String
Let strAmounts = Join(Amounts(), vbTab)
Let strAmounts = Join(Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab)
' similarly for the notes
Dim strNotes As String
Let strNotes = Join(Evaluate("=""Note"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab)
' To get our final heading string,
Dim strHd As String
Let strHd = "Group" & vbTab & Join(Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & Join(Evaluate("=""Note"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & "Notes"
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
objDataObject.SetText Text:=strHd
objDataObject.PutInClipboard
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets("Sheet1")
Ws1.Paste Destination:=Ws1.Range("G1")
End Sub
In the next post , https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16533&viewfull=1#post16533 , is that integrated into the main coding in Rem 3
DocAElstein
04-26-2022, 07:40 PM
Coding for these posts
https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16532&viewfull=1#post16532
Sub Stantially()
Rem 0 data
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets("Sheet1")
Dim RngPlus1 As Range
Set RngPlus1 = Ws1.Cells.Item(1).CurrentRegion.Resize(Ws1.Cells.I tem(1).CurrentRegion.Rows.Count + 1, Ws1.Cells.Item(1).CurrentRegion.Columns.Count)
Dim vArr() As Variant: Let vArr() = RngPlus1.Value2
Rem 1 determine the biggest group ( that maximum Amounts or Notes count )
Dim Cnt As Long, Cnt2 As Long, Mx As Long: Let Mx = 1: Let Cnt = 1
Do ' ############################# Main Outer Loop keeps us going through all data rows
Do ' ----------------- Inner Loop that takes us through a group
Let Cnt = Cnt + 1 ' Cnt is the main data row number
Let Cnt2 = Cnt2 + 1
Loop While vArr(Cnt + 1, 1) = vArr(Cnt, 1) ' ---- Inner Loop that takes us through a group
If Cnt2 > Mx Then Let Mx = Cnt2
Let Cnt2 = 0
Loop While Cnt < UBound(vArr(), 1) - 1 ' #### Main Outer Loop keeps us going through all data rows
Rem 2 ' ############################# Main Outer Loop keeps us going through all data rows
Let Cnt = 1
Do
Dim HrCnt As Long: Let HrCnt = 1
Dim strClipR As String, strClipL As String: Let strClipL = strClipL & vArr(Cnt + 1, 1)
Do '2a The first inner loop
Let Cnt = Cnt + 1
Let HrCnt = HrCnt + 1
Let strClipL = strClipL & vbTab & vArr(Cnt, 2)
Let strClipR = strClipR & vbTab & vArr(Cnt, 3)
Loop While vArr(Cnt + 1, 1) = vArr(Cnt, 1) ' The first inner loop
Do While HrCnt < Mx + 1 '2b the second inner loop
Let strClipL = strClipL & vbTab
Let strClipR = strClipR & vbTab
Let HrCnt = HrCnt + 1
Loop ' the second inner loop
'2c Finishing off the strings, and final string for an output line, after the inner loops
Let strClipR = strClipR & vbTab & vArr(Cnt, 4) ' add the group name
Dim strClip As String: Let strClip = strClip & strClipL & strClipR & vbCr & vbLf ' join the strings and add a line seperator to the output row string
'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strClip)
Let strClipL = "": strClipR = ""
Loop While Cnt < UBound(vArr(), 1) - 1 ' #### Main Outer Loop keeps us going through all data rows
'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strClip)
'2d paste strClip out via the windows Clipboard
Dim objDataObject As Object: Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
objDataObject.SetText Text:=strClip
objDataObject.PutInClipboard
Ws1.Paste Destination:=Ws1.Range("G2")
Rem 3 headers
Dim strHd As String
Let strHd = "Group" & vbTab & Join(Evaluate("=""Amount"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & Join(Evaluate("=""Note"" & COLUMN(A:" & Split(Cells(1, Mx).Address, "$")(1) & ")"), vbTab) & vbTab & "Name"
objDataObject.SetText Text:=strHd
objDataObject.PutInClipboard
Ws1.Paste Destination:=Ws1.Range("G1")
End Sub
DocAElstein
06-17-2022, 02:10 AM
Some extra notes for this main forum post:
http://www.eileenslounge.com/viewtopic.php?f=27&t=38331
This is a sample input,
_____ Workbook: Split- Copy.xlsm ( Using Excel 2007 32 bit )
Row\Col
A
B
21,2,3,4t,y,u,m
Worksheet: Sheet2Original
This is what I want out
_____ Workbook: Split- Copy.xlsm ( Using Excel 2007 32 bit )
Row\Col
A
B
2
1t
3
2y
4
3u
5
4m
Worksheet: Sheet2
I want to do this sort of thing,
__ arrOut()= App.Index(arrIn(), Rws(), Clms())
The arrIn() in this case will be all the input data. Conveniently, we can join the two cell values with a comma then split all that by comma to get a single array, {1 2 3 4 t y u m }
Then we need the Rws() like this
1 1
1 1
1 1
1 1
and the Clms() like this
1 5
2 6
3 7
4 8
' https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16639&viewfull=1#post16639
Sub SplitData4()
Dim Ws2 As Worksheet: Set Ws2 = ThisWorkbook.Worksheets.Item("Sheet2")
Dim strDta As String: Let strDta = Ws2.Range("A2").Value & "," & Ws2.Range("B2").Value
Dim arrIn() As String
Let arrIn() = Split(strDta, ",", -1, vbBinaryCompare)
' Or
arrIn() = Split(Range("A2").Value & "," & Range("B2").Value, ",")
Dim Rws() As Variant
Let Rws() = Evaluate("=Row(1:4)/Row(1:4)*Column(A:B)/Column(A:B)")
Let Rws() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")/Row(1:" & (UBound(arrIn()) + 1) / 2 & ")*Column(A:B)/Column(A:B)")
Dim Clms() As Variant
Let Clms() = Evaluate("=Row(1:4)+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")
Let Clms() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")
Dim arrOut() As Variant
Let arrOut() = Application.Index(arrIn(), Rws(), Clms())
Let Ws2.Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut()
' Or
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut()
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), Rws(), Clms())
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")/Row(1:" & (UBound(arrIn()) + 1) / 2 & ")*Column(A:B)/Column(A:B)"), Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")"))
Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")/Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")*Column(A:B)/Column(A:B)"), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")"))
End Sub
Sub StantiallyBeautiful() ' http://www.eileenslounge.com/viewtopic.php?f=27&t=38331
Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")/Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")*Column(A:B)/Column(A:B)"), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")"))
End Sub
In actual fact, we can simplify things a bit , since Intersexual interception theory (https://excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp) tells us that if Excel is looking for the indicies of this form
A b
C d
E f
G h
, but we only give it
1
, then it will see this instead
1 1
1 1
1 1
1 1
So that means we can replace Rws() with just 1
So that all simplifies it a bit…
Sub SplitData4b()
Dim Ws2 As Worksheet: Set Ws2 = ThisWorkbook.Worksheets.Item("Sheet2")
Dim strDta As String: Let strDta = Ws2.Range("A2").Value & "," & Ws2.Range("B2").Value
Dim arrIn() As String
Let arrIn() = Split(strDta, ",", -1, vbBinaryCompare)
' Or
arrIn() = Split(Range("A2").Value & "," & Range("B2").Value, ",")
'Dim Rws() As Variant
' Let Rws() = Evaluate("=Row(1:4)/Row(1:4)*Column(A:B)/Column(A:B)")
' Let Rws() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")/Row(1:" & (UBound(arrIn()) + 1) / 2 & ")*Column(A:B)/Column(A:B)")
Dim Clms() As Variant
Let Clms() = Evaluate("=Row(1:4)+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")
Let Clms() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")
Dim arrOut() As Variant
' Let arrOut() = Application.Index(arrIn(), Rws(), Clms())
Let arrOut() = Application.Index(arrIn(), 1, Clms())
Let Ws2.Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut()
' Or
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut()
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), 1, Clms())
' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), 1, Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")"))
Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), 1, Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")"))
End Sub
Sub StantiallyBeautifulb() ' http://www.eileenslounge.com/viewtopic.php?f=27&t=38331
Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), 1, Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")"))
End Sub
DocAElstein
06-22-2022, 12:42 PM
some more notes on it....
later.....
DocAElstein
06-22-2022, 12:43 PM
This is post https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16643&viewfull=1#post16643
https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16643&viewfull=1#post16643
https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)/page54#post16643
https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)/page54#post16643
Some more notes related to these posts
http://www.eileenslounge.com/viewtopic.php?f=27&t=38331&p=296482#p296482
Making it more flexible / dynamic, most for academic interest and aesthetic Pleasure
The code is flexible already in terms of the number of elements in each cell, ( but note The macro assumes the cells all have the same number of elements - like __ 1,2,3,4 __ t,y,u,m __ 5,6,7,8 __ a,b,c,d )
This post extends the flexibility to a dynamic number of cells used. ( While I was writing this, the OP asked for a mod to increase the used cells from 2 to 4, so a flexible solution is , as often, worthwhile )
We almost certainly need to know how many cells we have, and the usual way is done to get that,
__ Lc = Ws1.Cells(2, Ws1.Columns.Count).End(xlToLeft).Column
Join an array of the cells
The key to the new flexible solution is to Join the elements of an array with a comma, where the elements are the cell values, which themselves are separated already with a comma. (So then as previously, we then finally have a single string of comma separated values, which we , as previously split by a comma, to give us our single array of all data values.
Initially we can get an array of cell values from applying the .Value property to our multi cell range.
Something of this sort of form, for example, for if we had 4 cells in the second row,
_________arrCels2D1Row() = Ws1.Range("A2:D2").Value2
A small snag here is that the array returned by the .Value property, is a 1 row, 2 Dimensional array, ( a pseudo “horizontal” , “single width” array) but the VBA strings Join function only accepts a 1 dimensional array. However, it’s a strange characteristic of VBA that many things if they are asked to return something in the orientation of pseudo “horizontal” , “single width” , then they return a 1 Dimensional array: It seems that somehow the internal workings often relate a row orientation to a single dimensional array. ( This is convenient to think about, as is the idea of pseudo “horizontal” , “single width” , since in the case of a 1 dimensional array we often write it in a line like {1, 2, 3, 6, "z"} , but we should remember that strictly speaking academically orientation in arrays is subjective. )
As example this seemingly redundant code line takes the first row from our single row 2 Dimensional array: Seemingly useless, but in fact it returns the 1 Dimensional array of cell values, as we require, -
___ arrCels1D() = Application.Index(arrCels2D1Row(), 1, 0)
___ ___ - Effectively that converts a 2 Dimensional 1 row array into a 1 Dimensional array, and why VBA has that sort of strange characteristic thing is not clearly known
After this, we simply modify the previous solutions to replace some hard coded values with the dynamic Lc: For example we see the number 2 used frequently, when we originally had 2 cells, and this will likely need to be replaced by Lc, and correspondingly we used B in places where this will likely need to be replaced by the column letter corresponding to column Lc
Unfortunately, the final single code line does not quite fit on one line, but it is one code line, but needs to be split to get it in the VB Editor
Sub PrettydammBeautiful()
Range("A2").Resize((UBound(Split(Join(Application.Index(Rang e("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column, Cells(2, Columns.Count).End(xlToLeft).Column).Value = _
Application.Index(Split(Join(Application.Index(Ran ge("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")+((Column(A:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")"))
End Sub
Here the full story: see next post
DocAElstein
06-24-2022, 03:56 PM
Here is the full workings for the last macro from the last post
Sub SplitDataFlexibly() '
Rem 1 worksheets data info
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets.Item("Sheet1")
Dim Lc As Long: Let Lc = Ws1.Cells(2, Ws1.Columns.Count).End(xlToLeft).Column: Lc = Cells(2, Columns.Count).End(xlToLeft).Column
Rem 2 create a 1 Dimensional array of all data
Dim LCL As String: Let LCL = Split(Cells(1, Lc).Address, "$", 3, vbBinaryCompare)(1): LCL = Split(Cells(1, Lc).Address, "$")(1) ' what we are doing is splitting like $D$1 by the $ and then taking the second element, in the example that will be D
Dim arrCels2D1Row() As Variant: Let arrCels2D1Row() = Ws1.Range("A2:" & LCL & "2").Value2
Dim arrCels1D() As Variant: Let arrCels1D() = Application.Index(arrCels2D1Row(), 1, 0)
Dim strDta As String: Let strDta = Join(arrCels1D(), ",") 'Ws2.Range("A2").Value & "," & Ws2.Range("B2").Value
Rem 3 Making previous solution dynamic, - requires changing B with " & LCL & " and some hard coded occurasnces of 2 with Lc
Dim arrIn() As String
Let arrIn() = Split(strDta, ",", -1, vbBinaryCompare)
' Or
arrIn() = Split(Join(arrCels1D(), ","), ",")
Dim Clms() As Variant
' the next lines, used in previous example. is for the case of two cells, so we need to change some hard coded stuff to make the solution dynamic. ' Let Clms() = Evaluate("=Row(1:4)+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")
' Let Clms() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")
Let Clms() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(arrIn()) + 1) / Lc & ")")
Dim arrOut() As Variant
Let arrOut() = Application.Index(arrIn(), 1, Clms())
' Let Ws2.Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut() ' This was the case for 2 cells
Let Ws1.Range("A2").Resize((UBound(arrIn()) + 1) / Lc, Lc).Value = arrOut()
' Or
' Range("A2").Resize((UBound(arrIn()) + 1) / Lc, Lc).Value = arrOut()
' Range("A2").Resize((UBound(arrIn()) + 1) / Lc, Lc).Value = Application.Index(arrIn(), 1, Clms())
' Range("A2").Resize((UBound(arrIn()) + 1) / Lc, Lc).Value = Application.Index(arrIn(), 1, Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(arrIn()) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(arrCels1D(), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(arrCels1D(), ","), ","), 1, Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(arrIn()) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(arrCels1D(), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(arrCels1D(), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(arrCels1D(), ","), ",")) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(Split(Join(arrCels1D(), ","), ",")) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(arrC els2D1Row(), 1, 0), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(Application.Index(arr Cels2D1Row(), 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(arrCels2D1Row (), 1, 0), ","), ",")) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row (), 1, 0), ","), ",")) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Ws1. Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(Application.Index(Ws1 .Range("A2:" & LCL & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Ws1.Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Lc & ")+((Column(A:" & LCL & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row (), 1, 0), ","), ",")) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Ws1. Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(Application.Index(Ws1 .Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Ws1.Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Lc & ")+((Column(A:" & Split(Cells(1, Lc).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row (), 1, 0), ","), ",")) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Rang e("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Lc, Lc).Value = Application.Index(Split(Join(Application.Index(Ran ge("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Lc & ")+((Column(A:" & Split(Cells(1, Lc).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row (), 1, 0), ","), ",")) + 1) / Lc & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Rang e("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column, Cells(2, Columns.Count).End(xlToLeft).Column).Value = Application.Index(Split(Join(Application.Index(Ran ge("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")+((Column(A:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row (), 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Rang e("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column, Cells(2, Columns.Count).End(xlToLeft).Column).Value = Application.Index(Split(Join(Application.Index(Ran ge("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")+((Column(A:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(arrCels2D1Row (), 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Rang e("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column, Cells(2, Columns.Count).End(xlToLeft).Column).Value = Application.Index(Split(Join(Application.Index(Ran ge("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")+((Column(A:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(Range("A2:" & LCL & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")"))
' Range("A2").Resize((UBound(Split(Join(Application.Index(Rang e("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column, Cells(2, Columns.Count).End(xlToLeft).Column).Value = Application.Index(Split(Join(Application.Index(Ran ge("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")+((Column(A:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Lc).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")"))
Range("A2").Resize((UBound(Split(Join(Application.Index(Rang e("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column, Cells(2, Columns.Count).End(xlToLeft).Column).Value = _
Application.Index(Split(Join(Application.Index(Ran ge("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ","), 1, Evaluate("=Row(1:" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")+((Column(A:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & ")-1)*" & (UBound(Split(Join(Application.Index(Range("A2:" & Split(Cells(1, Cells(2, Columns.Count).End(xlToLeft).Column).Address, "$")(1) & "2").Value2, 1, 0), ","), ",")) + 1) / Cells(2, Columns.Count).End(xlToLeft).Column & ")"))
End Sub
DocAElstein
07-17-2022, 12:10 PM
In support of this main Forum post:
http://www.eileenslounge.com/viewtopic.php?p=297074#p297074 http://www.eileenslounge.com/viewtopic.php?p=297074#p297074
First overcomplicated Solution
Hello
.... in real these values will go to another WBK.
:::
or now just one question, "public" will always declare for userfrom means storing value either within WBK or for Other WBK.
Public means that the variable will be "known" in all code modules of the same workbook, but not in code modules in other open workbooks. .
If Public variables are being the things that go in a normal code module, as I think they are, technically, or officially, or words to that effect, then that is the case that they won’t be known in other workbooks.
In other words, for the purposes of what is going on here, it means you will need to be storing them in the same workbook, as Hans said, and how he demonstrated.
However, you can do something that technically is not involving Public variables, but as far as I can tell, to all intents and purposes, is in effect the same thing as if you could have those Public variable in a different workbook.
The short story is:
Instead of putting the two public variables in a standard normal code module, ( in the same workbook) as Hans did, we can put them in any Class object code module in any open workbook. Technically they are not called Public variables. They are , I think, properties of the instantiated Class object, and we can access them, in the usual way that we access properties of an object.
The full story
PurseWayDoughPublicVariables.xls
I have another workbook uploaded, PurseWayDoughPublicVariables.xls . That is just to hold these variables. (I will call them “pseudo” Public variables, just because I feel like it :) ),
I can put them in any Class object code module, but just for fun, I will put C1 in a worksheet code module, and C2 in the ThisWorkbook code module.
So, this is what Hans did, public variables in a standard normal module like
Standard module, Module1
Public C1 As String
Public C2 As String
Instead of doing that , I will put those variables in Class object code modules in PurseWayDoughPublicVariables.xls, like this:
Worksheet code module, Sheet1
Public C1 As String
'
'
'
Sub PhilC1(ByVal Wrd As String)
Let C1 = Wrd
End Sub
Workbook code module, ThisWorkbook
Public C2 As String
'
'
'
Sub PhilC2(ByVal Wrd As String)
Let C2 = Wrd
End Sub
*** The reason for those extra macros that fill the variables will be apparent shortly….
_.__________________________________-
Sample for Eli.xlsm
I need to modify now the workbook uploaded by Hans, in 3 main ways:
_(i) I don’t need the two public variables in a standard normal code module anymore
_(ii) I need to modify slightly how I reference the variables
Sub Fi_l()
'Act_ive
'Let Range("A2").Resize(10).Value = C1
Let Range("A2").Resize(10).Value = Workbooks("PurseWayDoughPublicVariables.xls").Worksheets("Sheet1").C1
'let Range("B2").Resize(10).Value = C2
Let Range("B2").Resize(10).Value = Workbooks("PurseWayDoughPublicVariables.xls").C2
End Sub
_(iii) Filling the variable is slightly more tricky. As far as I know, I can’t easily directly fill them from a macro in Sample for Eli.xlsm. - ***Edit: not true - see next post!! But I can run those extra macros*** that fill the variables, from Sample for Eli.xlsm
So to do that I modify the coding in the UserForm thus, ( for the purposes of this demo, I assume the two workbooks are stored in the same place):
Private Sub CommandButton1_Click()
Select Case Me.CheckBox1
Case True
'C1 = "yes"
Application.Run Macro:="'" & ThisWorkbook.Path & "\" & "PurseWayDoughPublicVariables.xls'!Sheet1.PhilC1", Arg1:="Yus"
End Select
Select Case Me.CheckBox2
Case True
'C2 = "yes"
Application.Run Macro:="'" & ThisWorkbook.Path & "\" & "PurseWayDoughPublicVariables.xls'!ThisWorkbook.Phi lC2", Arg1:="Ja"
End Select
Unload Me
Call Sheet2.Fi_l
End Sub
_.____
That’s it. So download both files, store them in the same place, and then the coding in Sample for Eli.xlsm should work as before. The only difference is that you are using the “pseudo” public variables in the workbook PurseWayDoughPublicVariables.xls
_.________________________________________________ _____________________
I have not seen this use of “pseudo” public variables much before, so there may be some reason I don’t know about why they should not be used??
But I use them myself sometimes, and so far I have never seen them behave any differently to “proper” public variables
( I would just finally say that I don’t use public variables much myself, pseudo or otherwise, if I can find another way to do what I want. I don’t like public variables myself. For one reason: I find they have an annoying habit of getting emptied sometimes. )
Alan
Ref
https://stackoverflow.com/questions/42908101/run-code-in-worksheets-class-code-module-in-another-workbook#
https://excelfox.com/forum/showthread.php/2404-Notes-tests-Application-Run-OnTime-Multiple-Variable-Arguments-ByRef-ByVal?p=11870&viewfull=1#post11870
https://stackoverflow.com/questions/31439866/multiple-variable-arguments-to-application-ontime/59812342#59812342
https://www.mrexcel.com/board/threads/reading-a-global-variable-from-another-workbook.963503/#post-4629654
DocAElstein
07-17-2022, 12:58 PM
In support of this main Forum post:
http://www.eileenslounge.com/viewtopic.php?p=297074#p297074 http://www.eileenslounge.com/viewtopic.php?p=297074#p297074
Second simplified Solution
I think in the first solution I made initially a mistake in trying to set the pseudo public variables, *** and so went off in a tangent using the Application.Run stuff. You don’t need any of that and can forget the two macros that fill the variables as well.
You just need this
Worksheet code module, Sheet1 ( in PurseWayDoughPublicVariables.xls )
Public C1 As String
Workbook code module, ThisWorkbook ( in PurseWayDoughPublicVariables.xls )
Public C2 As String
And then the other macros are like
Private Sub CommandButton1_Click()
Select Case Me.CheckBox1
Case True
'C1 = "yes"
' Application.Run Macro:="'" & ThisWorkbook.Path & "\" & "PurseWayDoughPublicVariables.xls'!Sheet1.PhilC1", Arg1:="Yus"
Let Workbooks("PurseWayDoughPublicVariables.xls").Worksheets("Sheet1").C1 = "Yus"
End Select
Select Case Me.CheckBox2
Case True
'C2 = "yes"
' Application.Run Macro:="'" & ThisWorkbook.Path & "\" & "PurseWayDoughPublicVariables.xls'!ThisWorkbook.Phi lC2", Arg1:="Ja"
Let Workbooks("PurseWayDoughPublicVariables.xls").C2 = "Ja"
End Select
Unload Me
Call Sheet2.Fi_l
End Sub
Sub Fi_l()
'Act_ive
'Let Range("A2").Resize(10).Value = C1
Let Range("A2").Resize(10).Value = Workbooks("PurseWayDoughPublicVariables.xls").Worksheets("Sheet1").C1
'let Range("B2").Resize(10).Value = C2
Let Range("B2").Resize(10).Value = Workbooks("PurseWayDoughPublicVariables.xls").C2
End Sub
DocAElstein
07-22-2022, 12:03 PM
Some extra notes for this Thread:
http://www.eileenslounge.com/viewtopic.php?f=30&t=38460
Hans Solution http://www.eileenslounge.com/viewtopic.php?p=297266#p297266
This is a nice solution which I totally misread, or rather in my ignorance, I did not understand.
The main point I missed is…
The solution assumes that the final solution actually has a 26 element 1 dimensional array, and the weight numbers in that array are sorted in alphabetical order, so that the first element represents the weight for “A” and the last Element represents the weight for “Z”, etc.
( So the array Letters() is redundant, and only the Weights() array is needed )
Hans has kindly set me straight and explained where I was going wrong. The final working version of his solution is
Sub Testit()
MsgBox prompt:=Weight("ZAC")
End Sub
' https://eileenslounge.com/viewtopic.php?f=30&t=38460&sid=4295ec4560088f42492ca29590271a87
Public Function Weight(S As String) As Long ' http://www.eileenslounge.com/viewtopic.php?p=297266#p297266
Dim Weights() As Variant ' Letters() As Variant,
Dim i As Long
' Letters = Array("A", "B", "C", ..., "Z")
' Weights = Array(1, 5, 3, ..., 2)
' A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z
Let Weights() = Array(1, 5, 3, 1, 4, 3, 2, 1, 6, 4, 5, 3, 2, 1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 2) ' Watch : - : Weights() : : Variant/Variant(0 to 25) : Module1.Weight
For i = 1 To Len(S)
Let Weight = Weight + Weights(Asc(Mid(S, i, 1)) - 65)
Next i
End Function
How is that working:
We are looping through each character, then doing something clever to get the running total. The clever bit is getting the array element
To demonstrate that working consider a couple of examples for the case of a word having an A and a Z in it
A has the Ascii Code number of 65. So we end up referring to Weights(65-65) = Weights(0) , which is the first element typically in a 1 dimensional array that starts at indicia 0
Z has the Ascii Code number of 90. So we end up referring to Weights(90-65) = Weights(25) , which is the last element in a 1 dimensional array of 26 elements that starts at indicia 0
In order for the function to get correct results in the case of lower case letters, then one way to do it, ( assuming you have the correct Weights() array you want for lower case letters), you would need to change the 65 to 97
Sub Testit()
Debug.Print Tab(4); "ASCII"; Tab(12); "Weight"
Debug.Print Tab(4); "Code"
Call Weight("ZAC")
Debug.Print
Call WeightLowerCase("zac")
End Sub
' https://eileenslounge.com/viewtopic.php?f=30&t=38460&sid=4295ec4560088f42492ca29590271a87
Public Function Weight(S As String) As Long ' http://www.eileenslounge.com/viewtopic.php?p=297266#p297266
Dim Weights() As Variant ' Letters() As Variant,
Dim i As Long
' A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z
Let Weights() = Array(1, 5, 3, 1, 4, 3, 2, 1, 6, 4, 5, 3, 2, 1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 2) ' Watch : - : Weights() : : Variant/Variant(0 to 25) : Module1.Weight
For i = 1 To Len(S)
Let Weight = Weight + Weights(Asc(Mid(S, i, 1)) - 65)
Debug.Print Mid(S, i, 1); Tab(4); Asc(Mid(S, i, 1)); Tab(8); Asc(Mid(S, i, 1)) - 65; Tab(12); Weights(Asc(Mid(S, i, 1)) - 65)
Next i
End Function
Public Function WeightLowerCase(S As String) As Long ' http://www.eileenslounge.com/viewtopic.php?p=297266#p297266
Dim Weights() As Variant ' Letters() As Variant,
Dim i As Long
' a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z
Let Weights() = Array(1, 5, 3, 1, 4, 3, 2, 1, 6, 4, 5, 3, 2, 1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 2) '
For i = 1 To Len(S)
Let WeightLowerCase = WeightLowerCase + Weights(Asc(Mid(S, i, 1)) - 97)
Debug.Print Mid(S, i, 1) & vbTab & Asc(Mid(S, i, 1)) & vbTab & Asc(Mid(S, i, 1)) - 97 & vbTab & Weights(Asc(Mid(S, i, 1)) - 97)
Next i
End Function
Here is the Debug.Print output from the last demo coding
ASCII Weight
Code
Z 90 25 2
A 65 0 1
C 67 2 3
z 122 25 2
a 97 0 1
c 99 2 3
DocAElstein
07-24-2022, 12:02 PM
Here is an alternative single liner ( almost ## ) type solution to the last post. It was much simpler than I expected, and ends up much shorter than these solutions of mine usually do. (## There was a small snag, not solved yet, which means I have to do it in 2 code lines for now. I may take a look at that later here: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16655&viewfull=1#post16655 )
Solution explanation.
Part 1. Background
This is all to do with
_ “my”** ____arrOut()=Index(ArrIn(), Rws(), Clms()) ______ type solutions, ( https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172 )
and also
_ using the Match in a similar way – ( some time ago I obsessed with trying out Application.Match where the first argument is an array, in a similar way to those of those array arguments Rws() and Clms() in Index. I got so obsessed I littered a sub forum with over long posts until they deleted them all and limited the post size to stop me doing it again. With hindsight, not a bad thing to do, as I could not see the wood for the trees back then. I can now, and its not at all difficult to understand, so I really don’t need all that crap anymore. Let me call that for now “my” **
________arrOut() = Match(arrArg1(), arrIn() , 0 ) ___ type solution.
( ** I use the word “my” lightly. – I learnt all this stuff from looking at stuff from Rick Rothstein and snb. ( I am not sure if they “invented it” , or got it from other peoples stuff. if I added anything “new” , it might be some of my detailed explanations, which whilst I don’t know if they are correct, they seem to be a valid theory as they go a long way to explain the results ) )
Here is a quick demo of how
_ my ____arrOut()=Match(arrArg1(), arrIn() , 0 ) ____ works
Ordinarily, or most usually the first argument is just one thing that you are looking for. As far as I know all documentation tells you that the way Match in Excel works is, ( simplified ) :
_... you look in the second argument array of things for the thing in the first argument, and , assuming you find it, return the position along where it is, pseudo like
_____ Match( b , { a, b, c } , 0 ) = 2
In the practice we sometimes, ( not always ) , find that things in Excel will work with array arguments and return a corresponding array of outputs. So taking that last example, pseudo like
_____ Match( {b, a} , { a, b, c } , 0 ) = {2, 1}
So that is a bit of theory out of the way. ( I have done a fuller explanation in a few places of how the Application.Index with Look Up Rows and Columns Arguments as VBA Arrays works in a few places
https://excelfox.com/forum/showthread.php/2788-Explain-App-Index(Rng-Rws()-Clms())-(multicolumn-Combobox-with-Index-application)?p=16455&viewfull=1#post16455
https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172 )
Part 2. Here is my solution examples
Refering to the first long macro below:
Rem1 is just making some stuff I need for the demo. I use the string example of “ZAC” as per the original OP example http://www.eileenslounge.com/viewtopic.php?f=30&t=38460 . For reasons given in the next bit, I make an array of the 26 Ascii Code numbers for the capital alphabet characters, A, B. C ….Z , Asskeys() = { 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81 ,82,83,84,85,86,87,88,89,90 }
My array of the weights values, Weights(), for the characters will be the same size as Asskeys() and will have the corresponding weight value for each of the 26 characters in the same order.
Once again it will be clear why later. For now, the point is to have arrays of the same size with related things in the same order
' ' Ascii Code 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81 ,82,83,84,85,86,87,88,89,90
' ' A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z
' Let Weights() = Array(1, 5, 3, 1, 4, 3, 2, 1, 6, 4, 5, 3, 2, 1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 2)
Rem 2
I found a way on the internet to turn my string example into an array of single characters, which is what I will be feeding into my Match as first argument. ( Unfortunately it does not return in each element the character, but rather its Ascii Code. But for my purposes that’s just as good.
Rem 3 Match
This is the Match bit, and it tells me the position along where I find the three Ascii Code numbers of “ZAC” in the Ascii Code array, Asskeys()
We get from match here, a 3 element array, MtchRes(), of the position along, of the characters in “ZAC” in the array Asskeys(). We have organised that the array of weights is organised in the same order, so this will also be the position along of the corresponding weight number in the array of weights, Weights().
In the example we should have then an array like {26, 1, 3} _ ( if you have followed the logic so far, you can see this is like a pseudo Alphabet position of the characters, Z , A , and C __ (But don’t get confused with Ascii codes, which is pseudo like the official position of characters, and defined by some world standard, that Excel knows about. As example, capital A is listed as Ascii code 65, lowercase a is listed as 97 )
Rem 4 Index
The 3 element array of the position along, of the characters in “ZAC” in the array Asskeys(), is effectively the Clms() array we need for a __arrOut()=Index(ArrIn(), Rws(), Clms())__type solution, where the look up array, arrIn() , will be the weights array, Weights()
The returned array from Index , arrOut(), will be an array, of 3 numbers, which are the weight numbers for the example string “ZAC”.
Rem 5
Finally we simply sum the elements of the found weight values, as per the original OP request.
Sub AssKeys()
Rem 1 Make the arrays and other hard coded things for the demo
Dim AssKeys(1 To 26) As Long
Dim Eye As Long
For Eye = 65 To 90 Step 1
Let AssKeys(Eye - 64) = Eye
Next Eye
' OR
' Dim AssKeys() As Variant: Let AssKey() = Array(65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90)
Dim Weights() As Variant:
' Ascii Code 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81 ,82,83,84,85,86,87,88,89,90
' A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z
Let Weights() = Array(1, 5, 3, 1, 4, 3, 2, 1, 6, 4, 5, 3, 2, 1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 2)
Dim ZAC As String
Let ZAC = "ZAC" ' This is a demo example text string
Rem 2 String to array
Dim arrZAC() As Byte: Let arrZAC() = StrConv(ZAC, vbFromUnicode) ' https://stackoverflow.com/questions/13195583/split-string-into-array-of-characters
Rem 3 Match
Dim MtchRes() As Variant
Let MtchRes() = Application.Match(arrZAC(), AssKeys(), 0)
Rem 4 Index
Dim arrOut() As Variant
Let arrOut() = Application.Index(Weights(), 1, MtchRes())
Rem 5
Dim Some As Long: Let Some = Application.Sum(arrOut())
End Sub
Here the shortening possibilities
Sub BeautifulAsskeys()
Rem 1 Make the arrays and other hard coded things for the demo
'Dim Asskeys(1 To 26) As Long
'Dim Eye As Long
' For Eye = 65 To 90 Step 1
' Let Asskeys(Eye - 64) = Eye
' Next Eye
' OR
' Dim AssKeys() As Variant: Let AssKey() = Array(65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90)
'Dim Weights() As Variant:
' ' Ascii Code 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81 ,82,83,84,85,86,87,88,89,90
' ' A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z
' Let Weights() = Array(1, 5, 3, 1, 4, 3, 2, 1, 6, 4, 5, 3, 2, 1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 2)
'Dim ZAC As String
' Let ZAC = "ZAC" ' This is a demo example text string
Rem 2 String to array
Dim arrZAC() As Byte: Let arrZAC() = StrConv("ZAC", vbFromUnicode) ' https://stackoverflow.com/questions/13195583/split-string-into-array-of-characters
Rem 3 Match
'Dim MtchRes() As Variant
' Let MtchRes() = Application.Match(arrZAC(), Asskeys(), 0)
' Let MtchRes() = Application.Match(StrConv(ZAC, vbFromUnicode), Asskeys(), 0)' this does not work
Rem 4 Index
'Dim arrOut() As Variant
' Let arrOut() = Application.Index(Weights(), 1, MtchRes())
Rem 5
Dim Some As Long: Let Some = Application.Sum(Application.Index(Array(1, 5, 3, 1, 4, 3, 2, 1, 6, 4, 5, 3, 2, 1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 2), 1, Application.Match(arrZAC(), Array(65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90), 0)))
End Sub
'
Sub AsKeys() ' http://www.eileenslounge.com/viewtopic.php?p=297288#p297288
Dim arrZAC() As Byte: Let arrZAC() = StrConv("ZAC", vbFromUnicode) ' https://stackoverflow.com/questions/13195583/split-string-into-array-of-characters
Dim Some As Long: Let Some = Application.Sum(Application.Index(Array(1, 5, 3, 1, 4, 3, 2, 1, 6, 4, 5, 3, 2, 1, 2, 3, 4, 5, 6, 7, 6, 5, 4, 3, 2, 2), 1, Application.Match(arrZAC(), Array(65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90), 0)))
End Sub
** I use the word “my” lightly. – I learnt all this stuff from looking at stuff from Rick Rothstein and snb. ( I am not sure if they “invented it” , or got it from other peoples stuff. if I added anything “new” , it might be some of my detailed explanations, which whilst I don’t know if they are correct, they seem to be a valid theory as they go a long way to explain the results
DocAElstein
07-24-2022, 12:49 PM
Spare post for sharing some documents
Ersatzpost für die gemeinsame Nutzung einiger Dokumente
https://i.postimg.cc/c6gJFyYS/Skizze-1-i-and-Skizze-2-ii.jpg (https://postimg.cc/c6gJFyYS)3932
https://i.postimg.cc/WpSJbs1h/Skizze-1-i-and-Skizze-2-ii.jpg (https://postimg.cc/c6gJFyYS)
https://i.postimg.cc/Lhc87CBZ/Skizze-2-i.jpg (https://postimg.cc/Lhc87CBZ)3933
https://i.postimg.cc/Wb3qdxdS/Skizze-2-i.jpg (https://postimg.cc/Lhc87CBZ)
https://i.postimg.cc/D4Xy0LFZ/Skizze-2-ii.jpg (https://postimg.cc/D4Xy0LFZ)3934
https://i.postimg.cc/rshdhNPS/Skizze-2-ii.jpg (https://postimg.cc/D4Xy0LFZ)
AlanSdattHof15Aug2022.docx
https://app.box.com/s/xxntrig04ppe7hdd68se882rm3fv2ysw https://bit.ly/3QXSEv0
AlanSdattHof15Aug2022.doc
https://app.box.com/s/pt4v46nl28qya2bfycgq2rdfz3a35fq8 https://bit.ly/3STVvqm
This post links
AlanSdattHof15Aug2022.docx
AlanSdattHof15Aug2022.doc
https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16655&viewfull=1#post16655
https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)/page55#post16655
https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16655&viewfull=1#post16655
https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)/page55#post16655
https://bit.ly/3AEPlmM https://bit.ly/3wmjQvh
DocAElstein
08-01-2022, 12:01 PM
In support of this main forum post
https://excelfox.com/forum/showthread.php/2803-Requirement-of-Excel-Formula
Assuming this is data and wanted results from column D
_____ Workbook: DogsNutsFormulas.xlsm ( Using Excel 2007 32 bit )
Row\Col
A
B
C
D
E
F
G
H
I
1CodeValuesCodeValue1Value2Value3Value4
2
1001
2101
1001
2101
5205
2605
9285
3
1001
5205
2604
4256
7458
3555
4
1001
2605
5
1001
9285
6
2604
4256
7
2604
7458
8
2604
3555
9
Worksheet: SimpleUniqueVLookUp
Enter this In D2 via CSE, then drag it down:
=IFERROR(INDEX($A$2:$A$8,MATCH(0,COUNTIF($D$1:D1,$ A$2:$A$8),0)),"")
Row\Col
D
2
=IFERROR(INDEX($A$2:$A$8,MATCH(0,COUNTIF($D$1:D1,$ A$2:$A$8),0)),"")
3
=IFERROR(INDEX($A$2:$A$8,MATCH(0,COUNTIF($D$1:D2,$ A$2:$A$8),0)),"")
Alternative formula for earlier versions of Excel:
=IF(ISERROR(INDEX($A$2:$A$8,MATCH(0,COUNTIF($D$1:D 1,$A$2:$A$8),0))),"",INDEX($A$2:$A$8,MATCH(0,COUNTIF($D$1:D1,$A$2:$A$8 ),0)))
Row\Col
D
2
=IF(ISERROR(INDEX($A$2:$A$8,MATCH(0,COUNTIF($D$1:D 1,$A$2:$A$8),0))),"",INDEX($A$2:$A$8,MATCH(0,COUNTIF($D$1:D1,$A$2:$A$8 ),0)))
3
=IF(ISERROR(INDEX($A$2:$A$8,MATCH(0,COUNTIF($D$1:D 2,$A$2:$A$8),0))),"",INDEX($A$2:$A$8,MATCH(0,COUNTIF($D$1:D2,$A$2:$A$8 ),0)))
Hi Amelynn
…..
If after TextBox(n) it is necessary to put the .text or .value
If not putting anything is wrong (although it works)
What is the difference between the three things……
I can’t answer most of your question here, unfortunately, because
_ I have no experience with Textboxes
_ I am not too familiar with the .Text property.
I can only tell you the small part that I know about: - what I know about is
Range__
Range__.Value
Range__.Value2
Range__ object
Range__ is an object with an extremely large number of properties, methods and various things.
Range__ is all to do with how Excel organises and uses cells. Understanding the Range__ object is probably one of the most important things to know about in Excel and VBA, especially if you are interested in spreadsheet things.
But many times, we are only interested in the value that is in a cell. Because most people are often only interested in the value in a cell, Microsoft have made .Value the default of what you get if you just use Range__. So most of the time if you choose to write just Range__ , then in fact , Excel will not see that, instead it will see and use Range__.Value
It is just personal choice if you choose to use Range__.Value or Range__. Usually there are no problems if you just use Range__ , but I have seen occasions when this caused problems as there may be occasions when Excel tries to refer to the Range__ object instead of the value.
So personally I prefer to always include the .Value if I am interested in a value. I will only leave out the .Value if I am doing something that wants me to reference the Range__ object. Just personal choice.
So, in your example, when you used Worksheets("Sheet1").Range("B10") , Excel did not see and use that.
Instead, Excel saw and used this: Worksheets("Sheet1").Range("B10").Value
....After the range, should I put .text, .value or just nothing? ... So in your examples you could probably just use nothing , but I personally would recommend that you include .Value ( or .Value2 )
But that is just my personally recommendation
.Value or .Value2
.Value is almost the simplest cell value. But not quite. If you are interested in dates or currency, then .Value will show you the date or currency in a date or currency format.
.Value2 is the most simplest cell value as Excel has it held before any formatting is done.
Personally I will use .Value2 most of the time, because it may work a little faster or may be less likely to problems caused by awkward cell formatting issues. I think theoretically it is also a bit more efficient to use .Value2
So….
.....If not putting anything is wrong (although it works)..... It is not wrong to put nothing. But it is bad practice, as it may cause problems in other situations in Excel VBA
(More than half of people put nothing, and they will often get a problem later that they don’t understand )
....Should I necessarily declare that, for example, "Niebla" is a variable of type Str?
The way that you are using "Niebla" in VBA coding is perfectly alright, because: Most of the time in VBA coding, if VBA sees something enclosed in quotes, _ "__" _ , like
"xyz"
, then VBA will take the value of _ xyz _ to be a string.
Even if , in your coding, you did this
"3"
, the VBA would not take the FONT=Courier New]"3"[/FONT] as a number. It would see it as a string, just as it would see this as a string
"I have 3 Apples"
Note that VBA is very user friendly with numbers and strings. For example if you pass it a string like "3" in a function wanting a number, the VBA will not error, but instead it will take a number 3 instead.
In many other computer languages you must be much more careful in defining precisely variable types.
That is as close as I can come to answering your question.
But I do know about Range__ , Range__.Value , Range__.Value2 quite well.
So I am happy to give you any further clarity on those things. Those things are all to do with range referencing in Excel and VBA, which is a very important thing to know about.
Alan
Ref
https://fastexcel.wordpress.com/2011/11/30/text-vs-value-vs-value2-slow-text-and-how-to-avoid-it/
DocAElstein
10-01-2022, 01:21 PM
Some notes in support of this forum main post
https://excelfox.com/forum/showthread.php/2821-Vlookup-and-Match-problem?p=16712&viewfull=1#post16712
An erroring formula: https://i.postimg.cc/nzbWtGTQ/An-erroring-formula.jpg
https://i.postimg.cc/mcjjYMvb/An-erroring-formula.jpg (https://postimg.cc/mcjjYMvb)
Highlight a section, such as the Match section https://i.postimg.cc/5NxZ0pJB/Highlight-match.jpg
https://i.postimg.cc/K4H9pPRj/Highlight-match.jpg (https://postimg.cc/K4H9pPRj)
Hit key F9 https://i.postimg.cc/7P1FwdFP/Hit-key-F9-it-tells-yopu-result-is-5.jpg
https://i.postimg.cc/Thw7c72B/Hit-key-F9-it-tells-yopu-result-is-5.jpg (https://postimg.cc/Thw7c72B)
This reveals that we have 5 , or in total , 5 + 1 = 6
So in the VLookUp we are looking at column 6 in the range given by bk
The names manager tells us which range we want:
Second formula section is the range bk https://i.postimg.cc/JhBFg23L/range-bk.jpg
https://i.postimg.cc/zL8pHpPt/range-bk.jpg (https://postimg.cc/zL8pHpPt)
Similarly we can investigate the first section in the erroring formula
Highlight first formula section https://i.postimg.cc/902syY7j/Highlight-first-formula-section.jpg
Hit key F9 https://i.postimg.cc/wvLStG3V/Hiut-F9-on-highhlighted-first-section.jpg
This reveals that the Look up value, the value that you are looking for is "DMG1"
Further investigations by trial and error , reveals that some character combinations in cell A2 cause the error. But I do not know why yet ?
Examples:
Not work:
https://i.postimg.cc/YqbTmg2J/d-not-work.jpg
https://i.postimg.cc/d0zbVYQ3/d-MG1-not-work.jpg
Works
https://i.postimg.cc/3xq6tTv1/MG1-works.jpg
In fact, it seems that some character combinations are not allowed as the Look Up value generally , for example try another cell, and I can find a character combination that does not work
https://i.postimg.cc/SK204shH/Not-working-some-characters-in-A6.jpg
https://i.postimg.cc/Ff4Cgh1x/Not-working-some-characters-in-A6.jpg (https://postimg.cc/Ff4Cgh1x)
I am puzzled.
In fact if you look in detail at the results you are getting when it does appear to work, then they are not alwaysthe correct values.
https://postimg.cc/kBnt3Zzg
https://i.postimg.cc/kBnt3Zzg/Wrong-resilts-from-VLook-Up.jpg (https://postimg.cc/kBnt3Zzg) https://i.postimg.cc/MKB0RJYV/Wrong-resilts-from-VLook-Up.jpg (https://postimages.org/)
Very strange. I am even more puzzled
?????
Update Answer from Sandy https://excelfox.com/forum/showthread.php/2821-Vlookup-and-Match-problem?p=16717&viewfull=1#post16717
with formula =VLOOKUP(F$26,bk,MATCH($B$24,bkt,1)+1,0) value $1.55 is returned and so on
..just forgot comma on the end or define last argument 0, VLOOKUP(F$26,bk,MATCH($B$24,bkt,1)+1,) so he need to learn how to use VLOOKUP function
VLOOKUP require all arguments, even if last argument is omitted there should be defined place for it after last comma
https://i.postimg.cc/ncHVbyD8/ThatsIt.gif (https://postimages.org/)
https://i.postimg.cc/15VpN7Hj/ThatsIt.jpg https://i.postimg.cc/N5Yy34Z6/ThatsIt.jpg (https://postimg.cc/N5Yy34Z6)
( I thought I had checked that, but missed something somewhere, I don’t know why I missed that, maybe I think also I need to learn how to use VLoopUp properly! )
DocAElstein
10-02-2022, 02:24 PM
Test
I see what you are saying its like “the 14th thing along” , like in if it was in a 1 dimensional or 1 “row” array,
This sort of thing
_number along{1 _ , 2 , 3 , 4 , 5 , 6 , 7 , 8 _ , 9 _ , 10_, 11_, 12_,13 , 14 __ , 15 , _16}
____INDEX({"Part",13,25,37,48,73,101,145,201,289,600,750,1009, "DMG1",4.1,2.85},1,14) = "DMG1"
Or similarly
__number along_____{1 _ , 2 , 3 , 4 , 5 , 6 , 7 , 8 _ , 9 _ , 10_, 11_, 12_,13 , 14 __ , 15 , _16}
__=MATCH("DMG1",{"Part",13,25,37,48,73,101,145,201,289,600,750,1009, "DMG1",4.1,2.85},0) = 14
(Note I must change the row separating ; before the to a column separating , **
I also get indexes mixed up and also I mix up item numbers and indexes. Sometimes they are the same, sometimes they have a similar meaning
( ** just passing interest, if in a range we talk about the “number along” on any range, then we are talking about the range item number, and this “number along” goes like all columns in a row, then next row and so on.
So example in both these ranges, the range item number is 14
Row\ColABCDEFGHIJKLMN
1Part13253748731011452012896007501009DMG1
Range("A1:N1").Item(14) = "DMG1"
Row\ColABCDEFGHIJKLM
1Part13253748731011452012896007501009
2DMG1 $ 4.10 $ 2.85 $ 2.85 $ 1.90 $ 1.55 $ 1.35 $ 1.25 $ 0.95 $ 0.85 $ 0.75 $ 0.75 $ 0.65
Range("A1:M2").Item(14) = "DMG1"
Row\ColOPQRSTUVW
4Part1325374873101145201
52896007501009DMG1 $ 4.10 $ 2.85 $ 2.85 $ 1.90
Range("O4:W5").Item(14) = "DMG1"
Here is a very interesting article by a very clever person on all that https://excelfox.com/forum/showthread.php/2789-Item-way-of-thinking-as-alternative-to-conventional-row-column-looping )
DocAElstein
10-02-2022, 05:49 PM
In support of this forum thread
https://excelfox.com/forum/showthread.php/2818-in-VBA-if-the-given-string-is-found-then-delete-everything-between-two-newlines-where-the-string-appears?p=16718&viewfull=1#post16718
In worksheet String to search is the following:
_____ Workbook: VBA delete everything between two newlines where the string appears.xlsx ( Using Excel 2007 32 bit )
Row\ColA
1
2paragraph/line
3
4searched string
5#VBA
Worksheet: String to search
Here is the given input examples ( The OP gave 4 cells , but for demo here I will put them all in the same code box and separate the 4 examples with a line. Black is the before/input , and Blue the after/ wanted output
in VBA if the given string is found then delete everything between two newlines where the string appears.
"Looking for help in VBA"
if the given string is found in any paragraph/line excel cell then delete everything between two newlines where the string appears. in VBA if the given string is found then delete everything between two newlines where the string appears.
"Looking for help in VBA"searched*string
if the given string is found in any excel cell then delete everything between two newlines where the string appears.
in VBA if the given string is found then delete everything between two newlines where the string appears.
"Looking for help in VBA"
if the given string is found in any excel cell then delete everything between two newlines where the string appears.
in VBA if the given string is found then delete everything between two newlines where the string appears.
"Looking for help in #VBA"
if the given string is found in any excel cell then delete paragraph/line everything between two newlines where the string appears.
in VBA if the given string is found then delete paragraph/line everything between two newlines where the string appears.
"Looking for help in VBA"
if the given string is found in any excel cell then delete everything between two newlines where the string appears.
searched*string
in VBA if the given string is found then delete everything between two newlines where the string appears.
"Looking for help in VBA"
if the given string is found in any excel cell then delete everything between two newlines where the string appears.
in VBA if the given string is found then delete everything between two newlines where the string appears.
"Looking for help in VBA"
if the given string is found in any paragraph/line excel cell then delete everything between two newlines where the string appears. in VBA if the given string is found then delete everything between two newlines where the string appears.
"Looking for help in VBA"searched*string
if the given string is found in any excel cell then delete everything between two newlines where the string appears.
in VBA if the given string is found then delete everything between two newlines where the string appears.
"Looking for help in VBA"
if the given string is found in any excel cell then delete everything between two newlines where the string appears.
in VBA if the given string is found then delete everything between two newlines where the string appears.
"Looking for help in #VBA"
if the given string is found in any excel cell then delete paragraph/line everything between two newlines where the string appears.
in VBA if the given string is found then delete paragraph/line everything between two newlines where the string appears.
"Looking for help in VBA"
if the given string is found in any excel cell then delete everything between two newlines where the string appears.
searched*string
in VBA if the given string is found then delete everything between two newlines where the string appears.
"Looking for help in VBA"
if the given string is found in any excel cell then delete everything between two newlines where the string appears.
OK so it looks quite clear what is needed. The OPs explanation does confirm to this, …. if the given string is found in any excel cell then delete everything between two newlines where the string appears.
… How can I delete sentences with a specific keyword in excel cells in all sheets?
…..but without the example it was much more difficult to understand and may have been interpreted to mean something else..
Putting the explanation of what is wanted a bit clearer, …
There is text in some cells. The text is split into paragraphs or lines, that is to say we see multi-line text, something like
How are you?
Well I am OK Bro today
Enjoying a wank just now.
What we want to do is: Modify the text in cells in this way: If certain words are found in a paragraph or line, then all the text in that line needs to be deleted. Lets say in that example, Bro was one of the words to search for. In that case, the text should be modified so as to look like this
How are you?
Enjoying a wank just now.
We remove all the text, Well I am OK Bro today, but it looks like the lines stay there.
We are manipulating text and some form of line separation is involved, so its usually a good idea to look carefully at the actual characters: Almost immediately I think of Splitting and Joining text where the thing to split by or use to join together will be a text line separator, which can vary. Hence important to take a look, so I will, here, later
https://excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA?p=16727&viewfull=1#post16727
DocAElstein
10-02-2022, 09:33 PM
In support of this main Forum Thread
https://excelfox.com/forum/showthread.php/2819-VBA-keep-only-one-searched-string
Input
"#VBA: keep only one searched string searched string searched string searched string.
#VBA: keep only searched string one searched string.
The list of search stings searchedCSV string searched string is given in sheet 2.
In sheet1, with #VBA check if a given string is CSV searched string found more than once in a paragraph/line. If found more than once then keep only one.
I want to do this both in an excel sheet with CSV searched string multiple column data in multiple rows as well as in a CSV or text file."
"searched string searched string #VBA: keep only one searched string.
#VBA: keep only one searched string.
searched string searched string searched stringThe list of search stings is given in sheet 2.
In sheet1, with #VBA check if a given string is found more than once #VBA #VBA #VBA #VBA #VBA #VBA #VBA #VBA #VBA #VBA #VBA #VBA in a paragraph/line. If found more than once then keep only one. #VBA #VBA #VBA #VBA
I want to do this both in an excel sheet with multiple column data in multiple rows as well as in a CSV or text file."
"#VBA: keep only one searched string.
#VBA: keep only one searched string.
The list of search stings is given in sheet 2.
In sheet1, with #VBA check if a given string is found more than once in a paragraph/line. If found more than once then keep only one.
I want to do this both in an excel sheet with multiple column data in multiple rows as well as in a CSV or text file. #VBA: keep only one searched string.
#VBA: keep only one searched string. searched string searched string searched string searched string
The list of search stings is given in sheet 2. searched string searched string searched string searched string
In sheet1, with #VBA check if a given string is found more than once in a paragraph/line. If found more than once then keep only one.
I want to do this both in an excel sheet with multiple column data in multiple rows as well as in a CSV or text file."
"#VBA: #VBA keep only one searched string.
#VBA: #VBA #VBAkeep only one searched string.
searched string searched string searched string searched string searched string
In sheet1, with #VBA check if a given string is found more than #VBA once in a paragraph/line. If found more than #VBA once then keep only one.
#VBA: keep only one searched string.
The list of search stings is given in sheet 2.
In sheet1, with #VBA check if a given string is found more than #VBA once in a paragraph/line. If found more than #VBA once then keep only one.
I want to do this both in an excel sheet with multiple column data in multiple rows as well as in a CSV or text file."
"#VBA: keep only one searched string.
In sheet1, with #VBA check if a given string is found more than once in a paragraph/line. If found more than once then keep only one.
I want to do this both in an excel sheet with multiple column data in multiple rows as well as in a CSV or text file. #VBA: keep only one searched string.
In sheet1, with #VBA check if a paragraph/line given string is found more than once in a paragraph/line paragraph/line. If found more than once then keep only one.
I want to do this both in an excel sheet with multiple column data in multiple rows as well as in a CSV or text file."
Output
"#VBA: keep only one searched string .
#VBA: keep only searched string one .
The list of search stings searchedCSV string searched string is given in sheet 2.
In sheet1, with #VBA check if a given string is CSV searched string found more than once in a paragraph/line. If found more than once then keep only one.
I want to do this both in an excel sheet with CSV searched string multiple column data in multiple rows as well as in a CSV or text file."
"searched string #VBA: keep only one searched string.
#VBA: keep only one searched string.
searched string searched stringThe list of search stings is given in sheet 2.
In sheet1, with #VBA check if a given string is found more than once in a paragraph/line. If found more than once then keep only one.
I want to do this both in an excel sheet with multiple column data in multiple rows as well as in a CSV or text file."
"#VBA: keep only one searched string.
#VBA: keep only one searched string.
The list of search stings is given in sheet 2.
In sheet1, with #VBA check if a given string is found more than once in a paragraph/line. If found more than once then keep only one.
I want to do this both in an excel sheet with multiple column data in multiple rows as well as in a CSV or text file. #VBA: keep only one searched string.
#VBA: keep only one searched string.
The list of search stings is given in sheet 2. searched string
In sheet1, with #VBA check if a given string is found more than once in a paragraph/line. If found more than once then keep only one.
I want to do this both in an excel sheet with multiple column data in multiple rows as well as in a CSV or text file."
"#VBA: keep only one searched string.
#VBA: keep only one searched string.
searched string
In sheet1, with #VBA check if a given string is found more than once in a paragraph/line. If found more than once then keep only one.
#VBA: keep only one searched string.
The list of search stings is given in sheet 2.
In sheet1, with #VBA check if a given string is found more than once in a paragraph/line. If found more than once then keep only one.
I want to do this both in an excel sheet with multiple column data in multiple rows as well as in a CSV or text file."
"#VBA: keep only one searched string.
In sheet1, with #VBA check if a given string is found more than once in a paragraph/line. If found more than once then keep only one.
I want to do this both in an excel sheet with multiple column data in multiple rows as well as in a CSV or text file. #VBA: keep only one searched string.
In sheet1, with #VBA check if a paragraph/line given string is found more than once in a paragraph/line paragraph/line. If found more than once then keep only one.
I want to do this both in an excel sheet with multiple column data in multiple rows as well as in a CSV or text file."
DocAElstein
10-03-2022, 02:42 PM
In support of this thread
https://excelfox.com/forum/showthread.php/2815-Copy-data-from-multiple-rows-between-two-keyword-and-paste-the-data-in-row(s)-of-single-cell-in-sheet2?p=16710&viewfull=1#post16710
Sheet1 Input in column A
_____ Workbook: VBA row to cell1.xlsx ( Using Excel 2007 32 bit )
Row\ColA
2234. digital marketing information: 2021-2022***….Keywrod1:
2021-2022***
3
4Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
5Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
6
7
8Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
9
10Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
11
12Keywrod1:
13Keyword2: 30000000 *&^%$QWERTY QWERTY
14
15
162344. digital marketing information: 2020-2021***….Keywrod1: *** 2020-2021
digital marketing information
digital marketing information
17
18Digital marketing: =
also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
19Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
20
21Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
22Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
23
24Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
25Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
26Keywrod1: *** 2020-2021
27Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
28Keyword2
29
301. digital marketing information: 2021-2022***….Keywrod1:
2021-2022***
31
32Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
33
34
35QWERTY Keyword2: 30000000 *&^%$QWERTY QWERTY
Worksheet: InputSheet1
"234. digital marketing information: 2021-2022***….Keywrod1:
2021-2022***"
"Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel."
"Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
"
"Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel."
"Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel."
Keywrod1:
Keyword2: 30000000 *&^%$QWERTY QWERTY
"2344. digital marketing information: 2020-2021***….Keywrod1: *** 2020-2021
digital marketing information
digital marketing information"
"Digital marketing: =
also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel."
"Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
"
"Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
"
"Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel."
"Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
"
"Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel."
Keywrod1: *** 2020-2021
"Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel."
Keyword2
"1. digital marketing information: 2021-2022***….Keywrod1:
2021-2022***"
"Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel."
QWERTY Keyword2: 30000000 *&^%$QWERTY QWERTY
Sheet2 Wanted output, next post
DocAElstein
10-03-2022, 02:52 PM
Output required ( https://excelfox.com/forum/showthread.php/2815-Copy-data-from-multiple-rows-between-two-keyword-and-paste-the-data-in-row(s)-of-single-cell-in-sheet2?p=16685&viewfull=1#post16685 )
_____ Workbook: VBA row to cell1.xlsx ( Using Excel 2007 32 bit )
Row\Col
A
2234. digital marketing information: 2021-2022***….Keywrod1:
2021-2022***
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Keywrod1:
Keyword2: 30000000 *&^%$QWERTY QWERTY
32344. digital marketing information: 2020-2021***….Keywrod1: *** 2020-2021
digital marketing information
digital marketing information
Digital marketing: =
also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel."
"Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel."
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel."
Keywrod1: *** 2020-2021
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Keyword2
41. digital marketing information: 2021-2022***….Keywrod1:
2021-2022***
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
QWERTY Keyword2: 30000000 *&^%$QWERTY QWERTY
Worksheet: OutputSheet2
"234. digital marketing information: 2021-2022***….Keywrod1:
2021-2022***
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Keywrod1:
Keyword2: 30000000 *&^%$QWERTY QWERTY"
"2344. digital marketing information: 2020-2021***….Keywrod1: *** 2020-2021
digital marketing information
digital marketing information
Digital marketing: =
also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.""
""Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.""
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.""
Keywrod1: *** 2020-2021
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Keyword2"
"1. digital marketing information: 2021-2022***….Keywrod1:
2021-2022***
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
QWERTY Keyword2: 30000000 *&^%$QWERTY QWERTY"
DocAElstein
10-03-2022, 04:30 PM
Further info for the last two posts
Input ( Sheet1)
_____ Workbook: VBA row to cell1.xlsx ( Using Excel 2007 32 bit )
Row\Col
A
301. digital marketing information: 2021-2022***….Keywrod1:
2021-2022***
31
32Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
33
34
35QWERTY Keyword2: 30000000 *&^%$QWERTY QWERTY
Worksheet: InputSheet1
"1. digital marketing information: 2021-2022***….Keywrod1:
2021-2022***"
"Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel."
QWERTY Keyword2: 30000000 *&^%$QWERTY QWERTY
Output Sheet 2
_____ Workbook: VBA row to cell1.xlsx ( Using Excel 2007 32 bit )
Row\Col
A
41. digital marketing information: 2021-2022***….Keywrod1:
2021-2022***
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
QWERTY Keyword2: 30000000 *&^%$QWERTY QWERTY
Worksheet: OutputSheet2
"1. digital marketing information: 2021-2022***….Keywrod1:
2021-2022***
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
Digital marketing, also called online marketing, is the promotion of brands to
connect with potential customers using the internet and other forms of digital communication.
This includes not only email, social media, and web-based advertising, but also
text and multimedia messages as a marketing channel.
QWERTY Keyword2: 30000000 *&^%$QWERTY QWERTY"
Test
Sept 14 https://www.youtube.com/watch?v=U76ZRIzBhOA https://bit.ly/3EuOh7B
May 14 https://www.youtube.com/watch?v=tPRv-ATUBe4 https://bit.ly/3rMAaTw
May 6 https://www.youtube.com/watch?v=7KPH608Av4E&list=PLc7fktTRMBow1ksFW020hx2XEKabaD5Vd&index=5 https://bit.ly/3TtTlNV
May 4 https://www.youtube.com/watch?v=nDlGkDENCyM https://bit.ly/3MkNUhC
Apr 29 https://www.youtube.com/watch?v=xqBhFPW_LuM&list=PLc7fktTRMBow1ksFW020hx2XEKabaD5Vd&index=6 https://bit.ly/3ejT2WX
DocAElstein
12-06-2022, 01:44 PM
This is post
https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)?p=19586&viewfull=1#post19586
https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)?p=19586&viewfull=1#post19586
https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)/page54#post19586
https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)/page54#post19586
In support of this main Forum Post http://www.eileenslounge.com/viewtopic.php?f=27&t=38973&p=301714#p301714
Do the transpose a bit differently using Application.Index
Consider this example of a Selectioned range:
ab
cd
ef
,and we want an output of some form like a b c d e f
Consider first a single column such as the first,
Let vTemp = Application.Transpose(Selection.Columns(1)) ' gives - {"a", "c", "e"}
We can Do the transpose a bit differently using Application.Index
Let vTemp = Application.Index(Selection, Array(1, 2, 3), Array(1, 1, 1)) ' - {"a", "c", "e"}
What's going on: Excel / Excel VBA is doing what it often does, along a row, then down a column, sometimes referred to as array type calculations, in this case the argument arrays are followed leading to an output of a form of the 1 dimensions, ("pseudo horizontal") array , as we want. The index works three times on each pair of co ordinates, each time giving the result in the way Index would in the more conventional way for just 1 pair of row and column co ordinates
Using this index way we are not restricted to a single column, we can pick any co ordinates we chose.
The next co ordinates give us a simple single line of all our cell values
Let vTemp = Application.Index(Selection, Array(1, 1, 2, 2, 3, 3), Array(1, 2, 1, 2, 1, 2)) ' {"a", "b", "c", "d", "e", "f"}
' Or
Dim Rws() As Variant, Clms() As Variant
Let Rws() = Array(1, 1, 2, 2, 3, 3): Clms() = Array(1, 2, 1, 2, 1, 2)
Let vTemp = Application.Index(Selection, Rws(), Clms()) ' ' {"a", "b", "c", "d", "e", "f"}
To make a more useful flexible solution, what we need to do is to get those array arguments dynamically from, in this example, the Selection
So on the face of it, it is quite easy what we need to do: It is usually just some seemingly clever, but actually quite basic maths. It is helpful perhaps to get in the head where/ why the problem / need for the maths comes in. It’s the difference between computers and us: Computers keep going, often things are listed or numbered in sequential number s ( example see item number way of doing things , https://excelfox.com/forum/showthread.php/2789-Item-way-of-thinking-as-alternative-to-conventional-row-column-looping ) but we use a paper/book or screen so keep going back/ (returning to the left) then up/down, (“Line feeding”)
In the various maths, the row count would usually feature less, or will feature in a similar way for slightly different examples, since mainly it effects ( along with the column count ) a final total number. In some examples the total number may be used and so the row count may never feature in any maths.
The column count is more prominent, since this size restriction is the human wanted chopping up of things to get them within our limited view, ( Generally we have a more limited width ( column ) than length (row) perception: we scroll more hapilly down than across. I don’t. My brain is more open minded and wide.
So we should be thinking more in terms of column count effecting things
Consider the requirement for the Rws()
For the case of more than one column, the sequential numbers need to be repeated for as many times as we have columns. So it is possibly a good guess that some division of that column count would be useful. Doing that division will give us
{.5, 1, 1.5, 2, 2.5, 3}
Observation of that shows we see something similar in the whole part of the numbers to what we want. But we don’t quite get what we want by taking the integer. We get
{0, 1, 1, 2, 2, 3}
We need to do something to correct what we get to what we want. It may not be obvious what we should do. If we consider another example it might help. So let’s consider 3 columns. Applying the same logic we would get
{0, 0, 1, 1, 1, 2}
It seems that the numbers which are to be dived by the column count and then taken the integer of, should not be {1, 2, 3, 4, 5, 6} , but for the case of 2 columns
{2, 3, 4, 5, 6, 7}
, and for the case of 3 columns
{3, 4, 5, 6, 7, 8}
So it looks like we want to add (ColumnCount-1) before the integer is done
Consider the requirement for the Clms()
We want to keep repeating the column sequence. The Mod function is promising for this, since it gives us what is left over after taking off as many as possible of the given number in the second argument. So whatever this gives us, will be repeated .
This, Mod(Column(A:F),2) , almost gets us there with {1, 0, 1, 0, 1, 0} and checking the same logic for 3 columns we have {1, 2, 0, 1, 2, 0}
We need to tweak that to get us to start at 0 and then add 1
_.______
Those ideas are incorporated into the full code version in the next post, https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)?p=19591&viewfull=1#post19591
Ref:
http://www.excelforum.com/excel-programming-vba-macros/1138428-multidimensional-array-to-single-column-range.html
http://www.excelforum.com/excel-programming-vba-macros/1138627-dividing-the-items-of-an-array-over-multiple-columns.html
DocAElstein
12-08-2022, 12:38 PM
Coding for last post
' https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)?p=19586&viewfull=1#post19586
' http://www.eileenslounge.com/viewtopic.php?f=27&t=38973&p=301714#p301714
Sub TransposeABitDifferent()
' Consider a two column, three row selection
' a b
' c d
' e f
Dim vTemp As Variant ' Use variant, and set a Shift+F9 watch on it ( To do this: Highlight it anywhere in the coding and use keys Shift+F9 )
' A single column transpose
Let vTemp = Application.Transpose(Selection.Columns(1)) ' gives - {"a", "c", "e"}
' Or we can Transpose in a different way, with index, and Stuff
Let vTemp = Application.Index(Selection, Array(1, 2, 3), Array(1, 1, 1)) ' - {"a", "c", "e"}
' What's going on: Excel / Excel VBA is doing what it often does, along a row, then down a column, sometimes referred to as array type calculations, in this case the argument arrays are followed leading to an output of a form of the 1 dimensions, ("pseudo horizontal") array , as we want. The index works three times on each pair of co ordinates, each time giving the result in the way Index would in the more conventional way for just 1 pair of row and column co ordinates
' using this way we are not restricted to a single column, we can pick any co ordinates we chose.
' The next co ordinates give us a simple single line of all our cell values
Let vTemp = Application.Index(Selection, Array(1, 1, 2, 2, 3, 3), Array(1, 2, 1, 2, 1, 2)) ' {"a", "b", "c", "d", "e", "f"}
' Or
Dim Rws() As Variant, Clms() As Variant
Let Rws() = Array(1, 1, 2, 2, 3, 3): Clms() = Array(1, 2, 1, 2, 1, 2)
Let vTemp = Application.Index(Selection, Rws(), Clms()) ' ' {"a", "b", "c", "d", "e", "f"}
' To make a more useful flexible solution, what we need to do is to get those array arguments dynamically from the Selection
' For both array aguments we need a 6 element 1 dimensional array
' ( we hit a snag generally in these things in that often Excel has those arrays but won't give us them, - typically it may only give us the first value. Noone is quite sure why. There are various tricks found empirically to make Excel give us the full array of values. Usually it involves putting what we actually want to do inside something that encourages Excel to return us all array values. (There may be some parallel to the so called C S E action in a spreadsheet to get full array results, noone is quite sure). Herfe is a trick I found, empirically to often work
' If({1}, here what you want to do ) I don't always need to do this. During the development of a solution I monitor ma results in vTemp , and if I onbl<y see a single result then I add this enclosing bit to see if that helps get me an array of results
' The start point is usually to get an array of the size we want of integers, and then fiddle with some maths to get the actual integer values we want
Let vTemp = Evaluate("=Column(A:F)") ' {1, 2, 3, 4, 5, 6}
' For a flexible solution we want the F Getting at a column letter is often a bit tricky, strangely Excel never made a function for it, whereas getting the column number is usually easy.
' In our case the column numnber is given by Selection.clumns.count
Let vTemp = Selection.Cells.Count ' 6
' there are a few ways to convert that to the appropriat Letter. An address way is convenient
Let vTemp = Split(Cells(1, 6).Address, "$")(1) ' - "F" This splits any row cell in column 6 address, in this example the cell $F$1, by a "$" resulting in an array {"", "F", "1"), we thne take the second element, which has the indice of 1 , (not 2 ,since such an array starts at the indicie of 0)
Let vTemp = Split(Cells(1, Selection.Cells.Count).Address, "$")(1) ' - "F"
Let vTemp = Evaluate("=Column(A:" & Split(Cells(1, Selection.Cells.Count).Address, "$")(1) & ")") ' {1, 2, 3, 4, 5, 6}
' ( To make the next steps easy to follow, we will stay with the "F" hard coded then substitute the bit to get it flexible later
Let vTemp = Evaluate("=Column(A:F)") ' {1, 2, 3, 4, 5, 6}
' Some maths now. There are probably a few ways. We fiddle around a bit. We try to get it using some numbers we could get dynamically, things typically of the count nature, such as row and column count, which are 3 and 2 in this example
' Rws()
Let vTemp = Evaluate("=Column(A:F)/2") ' {.5, 1, 1.5, 2, 2.5, 3}
Let vTemp = Evaluate("=Int(Column(A:F)/2)") ' 0
Let vTemp = Evaluate("=If({1},Int(Column(A:F)/2))") ' {0, 1, 1, 2, 2, 3}
Let vTemp = Evaluate("=Int((Column(A:F)+2)/2)") ' 1
Let vTemp = Evaluate("=If({1},Int((Column(A:F)+2)/2))") '
Let vTemp = Evaluate("=If({1},Int((Column(A:F)+(2-1))/2))")
Let vTemp = Evaluate("=If({1},Int((Column(A:F)+(" & Selection.Columns.Count & "-1))/" & Selection.Columns.Count & "))")
Let vTemp = Evaluate("=If({1},Int((Column(A:" & Split(Cells(1, Selection.Cells.Count).Address, "$")(1) & ")+(" & Selection.Columns.Count & "-1))/" & Selection.Columns.Count & "))")
Let Rws() = Evaluate("=If({1},Int((Column(A:" & Split(Cells(1, Selection.Cells.Count).Address, "$")(1) & ")+(" & Selection.Columns.Count & "-1))/" & Selection.Columns.Count & "))")
' Clms()
Let vTemp = Evaluate("=Mod(Column(A:F),2)") ' 1
Let vTemp = Evaluate("=If({1},Mod(Column(A:F),2))") ' {0, 1, 0, 1, 0, 1}
Let vTemp = Evaluate("=If({1},Mod((Column(A:F)-1),2)+1)") ' {1, 2, 1, 2, 1, 2}
Let vTemp = Evaluate("=If({1},Mod((Column(A:" & Split(Cells(1, Selection.Cells.Count).Address, "$")(1) & ")-1),2)+1)")
Let Clms() = Evaluate("=If({1},Mod((Column(A:" & Split(Cells(1, Selection.Cells.Count).Address, "$")(1) & ")-1),2)+1)")
Let vTemp = Application.Index(Selection, Rws(), Clms()) ' ' {"a", "b", "c", "d", "e", "f"}
' Do the Join
Dim StrOut As String
Let StrOut = Join(vTemp, ";"): Debug.Print StrOut ' a;b;c;d;e;f
End Sub
'
'
' Ref
' http://www.excelforum.com/excel-programming-vba-macros/1138428-multidimensional-array-to-single-column-range.html
' http://www.excelforum.com/excel-programming-vba-macros/1138627-dividing-the-items-of-an-array-over-multiple-columns.html
Sub SnberOne() ' http://www.eileenslounge.com/viewtopic.php?p=301714&sid=4705abb7ec796b7a3426c78642d4f638#p301714
Let Selection.Resize(1, 1).Offset(0, Selection.Columns.Count).value2 = Join(Application.Index(Selection, Evaluate("=If({1},Int((Column(A:" & Split(Cells(1, Selection.Cells.Count).Address, "$")(1) & ")+(" & Selection.Columns.Count & "-1))/" & Selection.Columns.Count & "))"), Evaluate("=If({1},Mod((Column(A:" & Split(Cells(1, Selection.Cells.Count).Address, "$")(1) & ")-1),2)+1)")), VBA.InputBox("separator", , ";")) ' a;b;c;d;e;f
End Sub
DocAElstein
04-21-2023, 11:18 PM
Some notes for this main forum post
https://eileenslounge.com/viewtopic.php?f=27&t=39588
https://postimg.cc/RqMKRrNz
https://i.postimg.cc/RqMKRrNz/Testing-Beaut-12344434444344.jpg (https://postimg.cc/RqMKRrNz)
_____ Workbook: report.xls ( Using Excel 2007 32 bit )
Row\ColABCDEFIJKLM
1DATAREQUIRE
2DIVISIONPOSITIONPOSITION REPORTINGLEVEL_NOempnocodeDIVISIONLEVEL_NOPOSITION empnocode
3XXOZ00301INDOL1E1LL81XX1OZ00301E1LL81
4XXLR0201OZ003012E2LL82XX2LR0201E2LL82
5XXLA0101LR02013E3LL83XX3LA0101E3LL83
6XXLA0201LR02013E4LL84XX4XX0101E11LL91
7XXLA0701LR02013E5LL85XX4XX0102E12LL92
8XXXX0502LA02014E6LL86XX4XX0103E13LL93
9XXXX0601LA02014E7LL87XX4XX0104E14LL94
10XXXX1901LA02014E8LL88XX3LA0201E4LL84
11XXXX2101LA02014E9LL89XX4XX0501E17LL97
12XXXX2201LA07014E10LL90XX4XX0502E6LL86
13XXXX0101LA01014E11LL91XX4XX0601E7LL87
14XXXX0102LA01014E12LL92XX4XX1901E8LL88
15XXXX0103LA01014E13LL93XX4XX2101E9LL89
16XXXX0104LA01014E14LL94XX3LA0701E5LL85
17XXXX0201LA07014E15LL95XX4XX0201E15LL95
18XXXX0301LA07014E16LL96XX4XX0301E16LL96
19XXXX0501LA02014E17LL97XX4XX2201E10LL90
Worksheet: Sheet1
sachin483 https://eileenslounge.com/viewtopic.php?p=306780#p306780
i have postion code and reporting postion and in 2 column but i want the format of reporting one below another ie :- 4 level will report to 3 and 3 level report to 2 and 2 level will report to 1 if any level is not there then create blank level for upper postion example in attached File
snb @ https://eileenslounge.com/viewtopic.php?p=306884#p306884
The crux in the question
Change the order of items from 1,2,3,3,3,4,4,4,4,4,4,4,4,4
to inserting the '4' items after the '3' item it belongs to (where cells(n,3) matches cells(y,2))
Resulting order: 1,2,3,4,4,4,3,4,4,4,3,4,4,4
Alan, a few hours later https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)?p=19938&viewfull=1#post19938
Change this
1,2, 3 , 3 , 3 , 4 , 4 , 4 , 4, 4 , 4 , 4 . 4 , 4 , 4 , 4 , 4
To this
1,2, 3 , 4 , 4 . 4 , 4 , 3 , 4 , 4 , 4 , 4 , 4 , 3 , 4 , 4 , 4
' or
Change this
1
2
3
3
3
4
4
4
4
4
4
4
4
4
4
4
4
To this
1
2
3
4
4
4
4
3
4
4
4
4
4
3
4
4
4
DocAElstein
04-21-2023, 11:18 PM
_____ Workbook: report.xls ( Using Excel 2007 32 bit )
Row\ColABCDEFIJKLM
1DATAREQUIRE
2DIVISIONPOSITIONPOSITION REPORTINGLEVEL_NOempnocodeDIVISIONLEVEL_NOPOSITION empnocode
3XXOZ00301INDOL1E1LL81XX1OZ00301E1LL81
4XXLR0201OZ003012E2LL82XX2LR0201E2LL82
5XXLA0101LR02013E3LL83XX3LA0101E3LL83
6XXLA0201LR02013E4LL84XX4XX0101E11LL91
7XXLA0701LR02013E5LL85XX4XX0102E12LL92
8XXXX0502LA02014E6LL86XX4XX0103E13LL93
9XXXX0601LA02014E7LL87XX4XX0104E14LL94
10XXXX1901LA02014E8LL88XX3LA0201E4LL84
11XXXX2101LA02014E9LL89XX4XX0501E17LL97
12XXXX2201LA07014E10LL90XX4XX0502E6LL86
13XXXX0101LA01014E11LL91XX4XX0601E7LL87
14XXXX0102LA01014E12LL92XX4XX1901E8LL88
15XXXX0103LA01014E13LL93XX4XX2101E9LL89
16XXXX0104LA01014E14LL94XX3LA0701E5LL85
17XXXX0201LA07014E15LL95XX4XX0201E15LL95
18XXXX0301LA07014E16LL96XX4XX0301E16LL96
19XXXX0501LA02014E17LL97XX4XX2201E10LL90
Worksheet: Sheet1
Change this
1,2, 3 , 3 , 3 , 4 , 4 , 4 , 4, 4 , 4 , 4 . 4 , 4 , 4 , 4 , 4
To this
1,2, 3 , 4 , 4 . 4 , 4 , 3 , 4 , 4 , 4 , 4 , 4 , 3 , 4 , 4 , 4
' or
Change this
1
2
3
3
3
4
4
4
4
4
4
4
4
4
4
4
4
To this
1
2
3
4
4
4
4
3
4
4
4
4
4
3
4
4
4
DocAElstein
04-22-2023, 01:07 AM
Some notes for this main forum post
https://eileenslounge.com/viewtopic.php?f=27&t=39588
This uses something quite smart stumbled across here
https://eileenslounge.com/viewtopic.php?p=266691#p266691
If we have a 1 D array of arrays , like form example { {"a", "b"} , { "c", "d" } } , then strangely it acts in our famous App Index Rws() Clms() Magic code line just as if it was an array like this
{"a", "b"
"c", "d" }
Strange , but true.
So in Hans macro from here,
http://www.eileenslounge.com/viewtopic.php?p=306785#p306785
, or rather the modified one from here ,
http://www.eileenslounge.com/viewtopic.php?p=306880#p306880
, instead of pasting a 1 D array out each time, so pasting out a line each time, we add that array to an array of arrays, then finally paste out that final array using the App Index Rws() Clms() Magic code line.
Effectively we are doing like this
Sub WonDeeArrayOfArrays() ' https://eileenslounge.com/viewtopic.php?p=266691#p266691
Dim arr1D(1 To 2) As Variant
Let arr1D(1) = Array("a", "b")
Let arr1D(2) = Array("c", "d")
Dim arrOut() As Variant
Let arrOut() = Application.Index(arr1D(), Evaluate("=ROW(1:2)"), Array(1, 2))
Let arrOut() = Application.Index(arr1D(), Evaluate("=ROW(1:2)"), Evaluate("=COLUMN(A:B)"))
End Sub
Option Explicit
Const SourceDivCol = 1
Const SourcePosCol = 2
Const SourceRepCol = 3
Const SourceLevCol = 4
Const SourceEmpCol = 5
Const SourceCodCol = 6
Const TargetDivCol = 15
Const TargetLevCol = 16
Const TargetPosCol = 17
Const TargetEmpCol = 18
Const TargetCodCol = 19
Dim SourceRow As Long
Dim TargetRow As Long
Dim Cnt As Long
Dim WunDeeArrayOfArrays() As Variant
Sub CreateReportHansAlan2() '
ReDim WunDeeArrayOfArrays(1 To Cells(1).CurrentRegion.Rows.Count - 2)
Dim Boss As Range
Dim Adr As String
Dim Pos As String
Application.ScreenUpdating = False
TargetRow = 2
Set Boss = Columns(SourceLevCol).Find(What:=1, LookAt:=xlWhole)
Adr = Boss.Address
Do
SourceRow = Boss.Row
TargetRow = TargetRow + 1
Let Cnt = Cnt + 1: Let WunDeeArrayOfArrays(Cnt) = Application.Index(Cells, SourceRow, Array(SourceDivCol, SourceLevCol, SourcePosCol, SourceEmpCol, SourceCodCol))
' Let Range("O" & TargetRow & ":S" & TargetRow & "").Value2 = Application.Index(Cells, SourceRow, Array(1, 4, 2, 5, 6))
' Let Range("O" & TargetRow & ":S" & TargetRow & "").Value2 = Application.Index(Cells, SourceRow, Array(SourceDivCol, SourceLevCol, SourcePosCol, SourceEmpCol, SourceCodCol))
' Cells(TargetRow, TargetDivCol).Value = Cells(SourceRow, SourceDivCol).Value
' Cells(TargetRow, TargetLevCol).Value = Cells(SourceRow, SourceLevCol).Value
' Cells(TargetRow, TargetPosCol).Value = Cells(SourceRow, SourcePosCol).Value
' Cells(TargetRow, TargetEmpCol).Value = Cells(SourceRow, SourceEmpCol).Value
' Cells(TargetRow, TargetCodCol).Value = Cells(SourceRow, SourceCodCol).Value
Pos = Cells(SourceRow, SourcePosCol).Value
Call AddKids(Pos)
Set Boss = Columns(SourceLevCol).Find(What:=1, After:=Boss, LookAt:=xlWhole)
If Boss Is Nothing Then Exit Do
Loop Until Boss.Address = Adr
Application.ScreenUpdating = True
Let Range("O3").Resize(Cells(1).CurrentRegion.Rows.Count - 2, 5).Value2 = Application.Index(WunDeeArrayOfArrays, Evaluate("=ROW(1:" & Cells(1).CurrentRegion.Rows.Count - 2 & ")"), Evaluate("=COLUMN(A:E)"))
End Sub
Sub AddKids(BossPos As String) '
Dim Child As Range
Dim Adr As String
Dim Pos As String
Set Child = Columns(SourceRepCol).Find(What:=BossPos, LookAt:=xlWhole)
If Child Is Nothing Then Exit Sub
Adr = Child.Address
Do
SourceRow = Child.Row
TargetRow = TargetRow + 1
Let Cnt = Cnt + 1: Let WunDeeArrayOfArrays(Cnt) = Application.Index(Cells, SourceRow, Array(SourceDivCol, SourceLevCol, SourcePosCol, SourceEmpCol, SourceCodCol))
' Let Range("O" & TargetRow & ":S" & TargetRow & "").Value2 = Application.Index(Cells, SourceRow, Array(SourceDivCol, SourceLevCol, SourcePosCol, SourceEmpCol, SourceCodCol))
' Cells(TargetRow, TargetDivCol).Value = Cells(SourceRow, SourceDivCol).Value
' Cells(TargetRow, TargetLevCol).Value = Cells(SourceRow, SourceLevCol).Value
' Cells(TargetRow, TargetPosCol).Value = Cells(SourceRow, SourcePosCol).Value
' Cells(TargetRow, TargetEmpCol).Value = Cells(SourceRow, SourceEmpCol).Value
' Cells(TargetRow, TargetCodCol).Value = Cells(SourceRow, SourceCodCol).Value
Pos = Cells(SourceRow, SourcePosCol).Value
Call AddKids(Pos)
Set Child = Columns(SourceRepCol).Find(What:=BossPos, After:=Child, LookAt:=xlWhole)
If Child Is Nothing Then Exit Do
Loop Until Child.Address = Adr
End Sub
Ref
https://eileenslounge.com/viewtopic.php?p=266691#p266691
https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172
https://www.excelforum.com/tips-and-tutorials/758402-vba-working-with-areas-within-2d-arrays.html#post5408376
https://www.excelforum.com/excel-programming-vba-macros/1328703-copy-1-dim-array-to-and-2-dim-array.html
http://www.eileenslounge.com/viewtopic.php?p=271035#p271035
https://www.ozgrid.com/forum/index.php?thread/1227920-slicing-a-2d-array/&postID=1239241#post1239241
https://eileenslounge.com/viewtopic.php?p=274367&sid=6b84ff6917c71e849aaeaa281d06fc31#p27436
https://eileenslounge.com/viewtopic.php?f=30&t=34217&p=265384#p265384
Ref
https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172
https://www.excelforum.com/tips-and-tutorials/758402-vba-working-with-areas-within-2d-arrays.html#post5408376
https://www.excelforum.com/excel-programming-vba-macros/1328703-copy-1-dim-array-to-and-2-dim-array.html
http://www.eileenslounge.com/viewtopic.php?p=271035#p271035
https://www.ozgrid.com/forum/index.php?thread/1227920-slicing-a-2d-array/&postID=1239241#post1239241 , https://eileenslounge.com/viewtopic.php?p=274367&sid=6b84ff6917c71e849aaeaa281d06fc31#p27436
https://eileenslounge.com/viewtopic.php?f=30&t=34217&p=265384#p265384
https://eileenslounge.com/viewtopic.php?p=266691#p266691
DocAElstein
04-23-2023, 11:15 AM
I missed the point, ( possibly ), with the OPs original data, saying he had like this
1,2, 3 , 3 , 3 , 4 , 4 , 4 , 4, 4 , 4 , 4 . 4 , 4 , 4 , 4 , 4
, but wanted this:
1,2, 3 , 4 , 4 . 4 , 4 , 3 , 4 , 4 , 4 , 4 , 4 , 3 , 4 , 4 , 4
I missed the point ( possibly ) that there could be more than one level 2 and that maybe the levels could go on a lot further above level 4. Maybe that additional information is obvious to most people? It is not to me. The more flexible open ended requirement would explain all the recursioning, explorer tree view type things discussed.
Never mind.. , a restricted scenario could still be useful to investigate for another solution.
Restricted solution
Restrictions:
One Big Boss , level 1
, a deputy who does all his work, Level 2
, or rather organises the line managers, level 3
, who in turn have all the workers organised beneath them, level 4
Macro Sub AlanAlmostGotThePointAgain()
Rem 0 I bring the data into an array in one go, to do some things a bit more efficiently, but this solution is still not a reduce the interaction with the workbook to 2 instances: reading data, writing the result
Rem 1 Based on the restrictions, this simply adds the first few lines in the final data for output, in the re ordered column order.
Rem 2a
A basic formula is used in an “Evaluate Range” type VBA code line. It’s based on a basic spreadsheet formula of the type
=IF(C5:C19=$B$4;ROW(B5:B19);0)
In words, what this is doing is:
For the level 2, the one position 2, LR0201 , is searched for in the POSITION REPORTING column C. The result is returned in the form of spreadsheet row number, and form the test data will look like this
5
6
7
0
0
0
0
0
0
0
0
0
0
0
0
In Rem 3 , this information gives us the count of level 3s, Lvl3s , and then in the first bit of Rem 4, Rem4a , we use this information to from the input array, the information at the correct position in the final output data array , ( using the running count position variable, Dw to give the required position in the final output data array )
Rem 4
This section is a typical inner loop within an outer loop type situation. Rem 4a in the outer loop section deals with the level 3 positions in the final output array, - at each of ( three in the sample data, ) level 3s we have a similar “Evaluate Range” formula to that used previously, - in this case, the formula in Rem 4b , based on this sort of spreadsheet formula,
=IF(C8:C19=$B$5;ROW(C8:C19);0)
, is used to give us the row within the input data to find each set of level 4s reporting to any particular level 3.
For example, on the case of the first outer loop, ( CntInds3 = 1 ) we look for a POSITION REPORTING of LA0101 , and obtain a spread of results of the following form from that single line evaluate range type formula
0
0
0
0
0
13
14
15
16
0
0
0
The inner loop of section Rem 4c deals with giving us the data in the output data array for those ) in the example data, 4 for the first outer loop, ) found level 4s reporting to the level 3 being considered in the outer loop.
Here is a full coding with some extra 'comment notes
'
Sub AlanAlmostGotThePointAgain() ' https://eileenslounge.com/viewtopic.php?p=306916&sid=baf68db6f023ebc9d65767c7abf9e19d#p306916
Rem 0 worksheets data info
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets.Item(1)
Dim arrIn() As Variant: Let arrIn() = Ws1.Range("A1").CurrentRegion.Value2 ' Ws1.Range("A1").CurrentRegion.Resize(Ws1.Range("A1").CurrentRegion.Rows.Count + 1).Value2
Dim arr1DArrays() As Variant ' https://eileenslounge.com/viewtopic.php?p=306912#p306912 https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)?p=19940&viewfull=1#post19940 https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)/page54#post19940
ReDim arr1DArrays(1 To UBound(arrIn(), 1)) ' ReDim arr1DArrays(1 To UBound(arrIn(), 1) - 1) ' Each element will be a row in the final output - see links in last line
Dim Lr As Long: Let Lr = UBound(arrIn(), 1)
Rem 1 some initial lines in the final output, based on the Restrictions of one Boss and 1 deputy, so in other words one level 1 and one level 2
Let arr1DArrays(1) = Application.Index(Ws1.Cells, 1, Array(1, 4, 2, 5, 6)) ' Ws1.Range("A1:E1").Value2 '
Let arr1DArrays(2) = Application.Index(Ws1.Cells, 2, Array(1, 4, 2, 5, 6))
Let arr1DArrays(3) = Application.Index(Ws1.Cells, 3, Array(1, 4, 2, 5, 6))
Let arr1DArrays(4) = Application.Index(Ws1.Cells, 4, Array(1, 4, 2, 5, 6))
Rem 2a
Dim Dw As Long: Let Dw = 4 ' The main data row for output. Dw is like a running count keeping note of the next line to add output data to
'Dim Lvl As Long: Let Lvl = 2
Dim srchVl As String: Let srchVl = arrIn(Dw, 2)
Dim arrInds3() As Variant: Let arrInds3() = Ws1.Evaluate("=IF(C5:C" & Lr & "=$B$4,ROW(B5:B" & Lr & "),0)")
Rem 3b
Dim Inds3 As Long
For Inds3 = 1 To UBound(arrInds3(), 1)
If arrInds3(Inds3, 1) = 0 Then: Dim Lvl3s As Long: Let Lvl3s = Inds3 - 1: Exit For
' If arrInds3(Inds3, 1) = 0 Then Let Dw = Dw + Inds3 + 2: Dim Lvl3s As Long: Let Lvl3s = Inds3 - 1: Exit For
' Let arr1DArrays(arrInds3(Inds3, 1) - 2) = Application.Index(Ws1.Cells, arrInds3(Inds3, 1), Array(1, 4, 2, 5, 6))
Next Inds3
Rem 4
Rem 4a
' now we want to investigate all the level 4s reporting to all the level 3s
Dim CntInds3 As Long ' Looping all level 3s
For CntInds3 = 1 To Lvl3s ' Looping all level 3s
Let Dw = Dw + 1
Let arr1DArrays(Dw) = Application.Index(Ws1.Cells, 5 + CntInds3 - 1, Array(1, 4, 2, 5, 6))
Rem 4b
Dim arrInds4() As Variant: Let arrInds4() = Ws1.Evaluate("=IF(C" & 5 + Lvl3s & ":C" & Lr & "=$B$" & 5 + CntInds3 - 1 & ",ROW(C" & 5 + Lvl3s & ":C" & Lr & "),0)")
Rem 4c
Dim CntInds4s As Long
For CntInds4s = 1 To UBound(arrInds4(), 1)
If arrInds4(CntInds4s, 1) = 0 Then
Else
Let Dw = Dw + 1 '
Let arr1DArrays(Dw) = Application.Index(Ws1.Cells, arrInds4(CntInds4s, 1), Array(1, 4, 2, 5, 6))
End If
Next CntInds4s
Next CntInds3
Rem 5 Output - convert the 1D array of 1D array output rows to a 2D range form
Let Range("AE1").Resize(Lr, 5).Value2 = Application.Index(arr1DArrays(), Evaluate("=ROW(1:" & Lr & ")"), Evaluate("=COLUMN(A:E)"))
End Sub
Final results and simplified coding in next posts
DocAElstein
04-24-2023, 03:56 PM
Sub AlanReporting() ' https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)?p=19941&viewfull=1#post19941
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets.Item(1)
Dim arrIn() As Variant: Let arrIn() = Ws1.Range("A1").CurrentRegion.Value2
Dim arr1DArrays() As Variant: ReDim arr1DArrays(1 To UBound(arrIn(), 1)) '
Dim Lr As Long: Let Lr = UBound(arrIn(), 1)
Rem 1 some initial lines in the final output, based on the Restrictions of one Boss and 1 deputy, so in other words one level 1 and one level 2
Let arr1DArrays(1) = Application.Index(Ws1.Cells, 1, Array(1, 4, 2, 5, 6)): arr1DArrays(2) = Application.Index(Ws1.Cells, 2, Array(1, 4, 2, 5, 6)): arr1DArrays(3) = Application.Index(Ws1.Cells, 3, Array(1, 4, 2, 5, 6)): arr1DArrays(4) = Application.Index(Ws1.Cells, 4, Array(1, 4, 2, 5, 6))
Rem 2a
Dim Dw As Long: Let Dw = 4
Dim srchVl As String: Let srchVl = arrIn(Dw, 2)
Dim arrInds3() As Variant: Let arrInds3() = Ws1.Evaluate("=IF(C5:C" & Lr & "=$B$4,ROW(B5:B" & Lr & "),0)")
Rem 3b
Dim Inds3 As Long
For Inds3 = 1 To UBound(arrInds3(), 1)
If arrInds3(Inds3, 1) = 0 Then: Dim Lvl3s As Long: Let Lvl3s = Inds3 - 1: Exit For
Next Inds3
Rem 4a
' now we want to investigate all the level 4s reporting to all the level 3s
Dim CntInds3 As Long ' Outer loop, Looping all level 3s ' ================================================== =
For CntInds3 = 1 To Lvl3s ' Looping all level 3s
Let Dw = Dw + 1
Let arr1DArrays(Dw) = Application.Index(Ws1.Cells, 5 + CntInds3 - 1, Array(1, 4, 2, 5, 6))
Rem 4b
Dim arrInds4() As Variant: Let arrInds4() = Ws1.Evaluate("=IF(C" & 5 + Lvl3s & ":C" & Lr & "=$B$" & 5 + CntInds3 - 1 & ",ROW(C" & 5 + Lvl3s & ":C" & Lr & "),0)")
Rem 4c
Dim CntInds4s As Long ' Inner loop, Looping all level 4s for a level 3 ' --------------------------------
For CntInds4s = 1 To UBound(arrInds4(), 1)
If arrInds4(CntInds4s, 1) = 0 Then
Else
Let Dw = Dw + 1 '
Let arr1DArrays(Dw) = Application.Index(Ws1.Cells, arrInds4(CntInds4s, 1), Array(1, 4, 2, 5, 6))
End If
Next CntInds4s ' ------------------------------------------------------------------------------------
Next CntInds3 ' ================================================== =======================================
Rem 5 Output - convert the 1D array of 1D array output rows to a 2D range form
Let Range("AE1").Resize(Lr, 5).Value2 = Application.Index(arr1DArrays(), Evaluate("=ROW(1:" & Lr & ")"), Evaluate("=COLUMN(A:E)"))
End Sub
_____ Workbook: report.xls ( Using Excel 2007 32 bit )
Row\ColAEAFAGAHAI
1DATA
2DIVISIONLEVEL_NOPOSITIONempnocode
3XX1OZ00301E1LL81
4XX2LR0201E2LL82
5XX3LA0101E3LL83
6XX4XX0101E11LL91
7XX4XX0102E12LL92
8XX4XX0103E13LL93
9XX4XX0104E14LL94
10XX3LA0201E4LL84
11XX4XX0502E6LL86
12XX4XX0601E7LL87
13XX4XX1901E8LL88
14XX4XX2101E9LL89
15XX4XX0501E17LL97
16XX3LA0701E5LL85
17XX4XX2201E10LL90
18XX4XX0201E15LL95
19XX4XX0301E16LL96
Worksheet: Sheet1
DocAElstein
04-24-2023, 04:23 PM
We note a slight difference in order presented in the final results for the level 4s,
https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)?p=19943&viewfull=1#post19943
https://bit.ly/3LpFarN
, when compared with results from the other solutions so far given
https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)?p=19944&viewfull=1#post19944
https://bit.ly/3L5bLBV
- This sort of difference is commonly seen when comparing explorer / recursioning type solutions with simpler looping ones which build up the results one line after the other - recursioning type solutions go up and down the explorer tree view structure thingy and so often order the final results a bit differently.
_____ Workbook: report.xls ( Using Excel 2007 32 bit )
Row\ColIJKLMAEAFAGAHAI
1REQUIREDATA
2DIVISIONLEVEL_NOPOSITIONempnocodeDIVISIONLEVEL_NO POSITIONempnocode
3XX1OZ00301E1LL81XX1OZ00301E1LL81
4XX2LR0201E2LL82XX2LR0201E2LL82
5XX3LA0101E3LL83XX3LA0101E3LL83
6XX4XX0101E11LL91XX4XX0101E11LL91
7XX4XX0102E12LL92XX4XX0102E12LL92
8XX4XX0103E13LL93XX4XX0103E13LL93
9XX4XX0104E14LL94XX4XX0104E14LL94
10XX3LA0201E4LL84XX3LA0201E4LL84
11XX4XX0501E17LL97XX4XX0502E6LL86
12XX4XX0502E6LL86XX4XX0601E7LL87
13XX4XX0601E7LL87XX4XX1901E8LL88
14XX4XX1901E8LL88XX4XX2101E9LL89
15XX4XX2101E9LL89XX4XX0501E17LL97
16XX3LA0701E5LL85XX3LA0701E5LL85
17XX4XX0201E15LL95XX4XX2201E10LL90
18XX4XX0301E16LL96XX4XX0201E15LL95
19XX4XX2201E10LL90XX4XX0301E16LL96
Worksheet: Sheet1
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.